perm filename NETGRF.FAI[S,NET] blob
sn#679002 filedate 1982-09-23 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00080 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00008 00002 TITLE NETGRF
C00013 00003 Macros
C00016 00004 Opcode Definitions
C00018 00005 Data Structures:
C00019 00006 START - Initialization and Main Loop
C00026 00007 EXIT - Change name and stop
C00027 00008 RDMAIL - Read the Mail
C00029 00009 - Letter format
C00031 00010 NEWICP - Start up new ICP
C00035 00011 NEWCON - Make new connection
C00041 00012 CONEST - Connection Established.
C00047 00013 GRFLIS - Set up to listen from graphics connection
C00051 00014 GRFEST - Graphics Connection Established!
C00053 00015 SNDGRE - Send Graphics Greeting
C00055 00016 SNDIII - Send III buffer
C00058 00017 USECHK - Check to see if anyone's here
C00060 00018 STATUS - Print status of NETGRF
C00066 00019 CHGJOB - Change job paramenters
C00068 00020 OUTWHR - Write out WHERE table for MAIL, FINGER, etc.
C00069 00021 -------------------------------------------------
C00070 00022 INTSER - Interrupt Service Routine
C00081 00023 CLKSER - Service clock interrupt
C00084 00024 IMPCHG - IMP status change
C00088 00025 PTYSER - Service PTY
C00092 00026 IMLHAK - Hack Imlac compatability mode
C00099 00027 NEWPRO - Interpet new TELNET protocol
C00110 00028 NETOPN - Open duplex network connection
C00115 00029 SPY - Find out who is using NETGRF
C00117 00030 GRISER - Graphic Input Service
C00118 00031 RDINQRS- Read Inquiry Response
C00122 00032 RCVCNT - Recieve Graphics Count
C00123 00033 RCV32 - Receive 32 bits
C00124 00034 GRFERM - Graphics error message
C00125 00035 IIISIM - Simulate III Display
C00139 00036 SNDCOOR- Send coordinates
C00141 00037 SNDCNT - Send count (for NGP)
C00142 00038 STRLEN - Length of ASCIZ string
C00143 00039 SNDSTR - Send string (for NGP)
C00144 00040 SNDNAM - Send segment name (for NGP)
C00145 00041 -------------------------------------------------
C00146 00042 GET1K - Get a 1024 word block
C00148 00043 REL1K - Release a 1024 word block
C00150 00044 MKPBLK - Make a Process Block
C00153 00045 MKPROC - Make a Process
C00155 00046 KLPROC - Kill a Process or Process Block
C00157 00047 ENQUE - Enter into Queue
C00160 00048 ENTCLK - Enter into Clock Queue
C00165 00049 DEQUE - Delete first entry from queue
C00167 00050 SRHQUE - Search queue and delete entry
C00170 00051 SCHED - Schedule a Process
C00171 00052 RESCHED- Request to be Rescheduled (also WSCHED)
C00174 00053 DELAY - Schedule a Process in future
C00175 00054 POSTPON- Request to be Rescheduled
C00177 00055 RUNPROC- Run a Process
C00179 00056 PREXIT - Process Exit
C00180 00057 GETPRO - Get process pointer from stack pointer
C00181 00058 GTUSID - Get User Id
C00183 00059 KLUSER - Kill user and release associated storage ***
C00190 00060 FNDPTY - Find user number from pseudoteletype line
C00191 00061 MKRBUF - Make Ring Buffers for System I/O
C00193 00062 KLRBUF - Kill Ring Buffers
C00194 00063 ENLOCK - Enter interlock
C00196 00064 DELOCK - Leave interlock
C00198 00065 LOKENB - Enable interrupts inside an interlock
C00199 00066 LOKWAI - Wait for interlock
C00200 00067 USERMO - Enter user mode ***
C00202 00068 LOGIT - Log messages
C00206 00069 SETCHK - Initialize checksum of pure code
C00209 00070 SYSCHK - Checksum pure code and fix if pure code modified
C00213 00071 CALCHK - Calculate checksum
C00214 00072 -------------------------------------------------
C00215 00073 IMPOCNT- Return number of bytes which we can send IMP without waiting
C00217 00074 IMPOCHR- Send character to IMP
C00222 00075 IMPOUT - Output buffer to IMP
C00224 00076 IMPSTR - Output string to IMP
C00226 00077 IMICHS - Skip if character ready from IMP
C00234 00078 IMPIN - Input buffer from IMP
C00235 00079 Misc. output routines: TYPOCT,TYPDEC,DRYROT
C00237 00080 Storage
C00249 ENDMK
C⊗;
TITLE NETGRF
;
; Network Graphics Protocol Server
; Also handles multiple TELNET users
; Also accepts D. King (of UCB) variant of NGP
; (4 bits per byte down TELNET connection)
;
IFNDEF NUSERS,< PRINTS/NUSERS(3),NEWPRO(1),OLDPRO(0),GRFPRO(1)
/↔ .INSERT TTY:
>
.INSERT INTDEF.FAI[1,TVR]
;;;.INSERT IMPDEF.FAI[NET,TVR]
.INSERT NETDEF.[S,SYS]
.LIBRARY TVRLIB.REL[SUB,SYS]
EXTERNAL JOBAPR,JOBCNI,JOBTPC
; Parameters
IFNDEF NUSERS,< ↓NUSERS ←← 3 > ;Maximum number of users
IFNDEF NEWPRO,< ↓NEWPRO ←← 1 > ;Assume new protocol
IFNDEF OLDPRO,< ↓OLDPRO ←← 0 > ;Assume ignoring old protocol
IFNDEF GRFPRO,< ↓GRFPRO ←← 1 > ;Assume graphics
IFNDEF DEBPRC,< ↓DEBPRC ←← 0 > ;Assume not debugging process code
IFNDEF DKPRO ,< ↓DKPRO ←← GRFPRO >;Assume D. King format allowed
IFNDEF CHKSW ,< ↓CHKSW ←← 0 > ;Assume not wanting checksum feature
IFNDEF SPYSW ,< ↓SPYSW ←← 1 > ;Assume wanting to know who's using it
IFNDEF NEWSW ,< ↓NEWSW ←← 0 > ;For testing
IFNDEF IMLSW ,< ↓IMLSW ←← 0 > ;Handle Extended-ASCII in IMLAC mode
IFG NUSERS-7,< .FATAL Number of users limited to 7 because of I/O channels limitations.
>;IFG
; GRFMUL is multiplier for tables which need to be expanded for graphics
; due to second IMP connection.
IFE GRFPRO,< ↓GRFMUL ←← 1 >
IFN GRFPRO,< ↓GRFMUL ←← 2 >
↓NSPECU ←← 1 ;Number of Special uses
↓U.ICP ←← GRFMUL*NUSERS ;ICP user
↓QUESIZ ←← 3 ;Size of queue block
↓PROCSZ ←← 100 ;Size of process block
↓LOCKSZ ←← 1 ;Size of lock block
↓MTSIZE ←← 11 ;Largest is GET ALLOCATIONS
↓DAYTIC ←← =24*=60*=60*=60 ;Number of tics per day
;Checksum channel (not used normally and IOPUSHed and IOPOP when it is)
IFN CHKSW,<
↓CHKCHN ←← 0 ;Channel used for checking
>;IFN CHKSW
; Accumulator definitions
↓RET ← 1 ;Results returned here
↓A ← 2
↓B ← A+1
↓C ← B+1
↓D ← C+1
↓E ← D+1
↓F ← E+1
↓TAC ← 11 ;Temperary ac
↓TAC2 ← TAC+1 ;Another temperary
↓U ← 16 ;User number
↓P ← 17 ;Stack pointer
; Flag bits
↓WHOBIT ← 1B0 ;WHO line in progress
↓GREBIT ← 1B1 ;Has recieved greeting from graphics connection
↓INQBIT ← 1B2 ;We have inquired him/her
; Random TTY bit definitions
FULTWX←←4 ; ON FOR HALF DUPLEX
xon←←2 ; don't generate lf after CR
COMMENT ⊗ Problems:
Calls to DRYROT must be fixed someday
OPEN in NEWCON is not reentrant!!!
Allocation of ring buffer is such that storage allocated them can be lost
under certain obscure conditions.
⊗;
COMMENT $ Debugging character
< Enter interlock
> Leave interlock
≤ Enter clock queue
⊗ CLKSER running
≥ Leave clock queue
+ Schedule process
- Run process
* IMP status change
{ IMP input noticed
} IMP input finished
← PTY output noticed
→ PTY output finished
$;
SUBTTL Macros
DEFINE MOVBI(AC,BITS)
<IFE BITS∧777777,< MOVSI AC,(BITS);>IFE BITS∧777777000000,<MOVEI AC,BITS;>MOVE AC,[BITS]>
IFN NEWPRO,<
DEFINE PROBIT `(X) <1B`X>
>
DEFINE EXIT(AC)
<IFIDN <AC><>< PUSHJ P,DOEXIT >IFDIF <AC><>,< CALLI AC,12>>
DEFINE ENTERLOCK(LOCKBLOCK)
< PUSHJ P,ENLOCK
LOCKBLOCK
>
DEFINE LEAVELOCK(LOCKBLOCK)
< PUSHJ P,DELOCK
LOCKBLOCK
>
DEFINE TURNON(ADR)
< SKIPL LOKCNT
PUSHJ P,LOKENB
IMSKST ADR
>
DEFINE TURNOFF(ADR)
< IMSKCL ADR
>
DEFINE PUSHACS
< PUSHJ P,PUSHIT↑
>
DEFINE POPACS
< PUSHJ P,POPIT↑
>
DEFINE ACCUMULATORS(LIST)
< ACPTR←←2
FOR AC⊂(LIST)
< AC←ACPTR
ACPTR←←ACPTR+1
>>
;FATAL ERROR MESSAGE.
IFNDEF FATAL.
< DEFINE FATAL(STR){PUSHJ 17,FATAL.↑↔JFCL [ASCIZ/STR/]}
>
IFNDEF WARN.
< DEFINE WARN(STR){PUSHJ 17,WARN.↑↔JFCL [ASCIZ/STR/]}
>
;CHAIN TOGETHER BIT TABLES FOR RAID
DEFINE BITDEFS(BITS)
<IFNDEF .BTLNK, < .BTLNK←←0
>; .BTLNK
.BTLNK←←.BTLNK*1000000+.
.BTABL←←$.
FOR BIT⊂(BITS)
<IFIDN <><BIT>< 0
;> RADIX50 0,BIT
> BLOCK =36+.BTABL-$.
>
BITDEF<INTSWW,INTSWD,INTSHW,INTSHD,INTTTY,INTPTI,INTMAIL,INTWAIT,INTPTO,INTPAR,INTCLK
,INTINR,INTINS,INTIMS,INTINP,INTTTI,INTQXF,,,POV,,,ILM,NXM,,,OLDCLK,,,INTFOV,,,INTOV,,,>
;BITDEF<WHOBIT,GREBIT,INQBIT>
IFN NEWSW,<
DEFINE ENTERLOCK(LOCKBLOCK)
<
AOSE LOCKBLOCK
PUSHJ P,ENLWAI
>
DEFINE LEAVELOCK(LOCKBLOCK)
< SOSL LOCKBLOCK
PUSHJ P,ENLCON
>
DEFINE TURNON(ADR)
< SKIPL LOKCNT
PUSHJ P,LOKENB
IMSKST ADR
>
>;IFN NEWSW
;GENERATE SUBROUTINE CALL
DEFINE CALL(NAME,X1,X2,X3,X4,X5,X6){
XLIST
IFDIF <><X1>{PUSH 17,X1
IFDIF <><X2>{PUSH 17,X2
IFDIF <><X3>{PUSH 17,X3
IFDIF <><X4>{PUSH 17,X4
IFDIF <><X5>{PUSH 17,X5
IFDIF <><X6>{PUSH 17,X6
}}}}}}
IFDIF <><NAME>{PUSHJ P,NAME
}
LIST}
SUBTTL Opcode Definitions
;TELNET opcodes
DEFINE TELOPC(SHORT,CODE,DESCR)
< ↓SHORT←←CODE ;DESCR
>
DEFINE TELOPT(SHORT,CODE,DESCR)
< ↓SHORT←←CODE ;DESCR
>
;Graphics opcodes
DEFINE NGPOP(SHORT,CODE,OPT,LONG)
< ↓SHORT←←=CODE ;OPT LONG
>
DEFINE NGPDEF(SHORT,CODE,LONG)
< ↓SHORT←←=CODE ;LONG
>
DEFINE NGPINQ(SHORT,CODE,OPT,LONG)
< ↓SHORT←←=CODE ;OPT LONG
>
IFN NEWPRO,< .INSERT TELOP.DEF[CSP,SYS] >
IFN GRFPRO,< .INSERT NGPOP.DEF[CSP,SYS] >
IFN DKPRO,<
; Losing D. King format:
; <begin graphics>
;;block of form:
; <high order 4 bits>
; <low order 4 bits>
; <end graphics>
DKESC←←20
DKBEG←←21
DKEND←←22
>;IFN DKPRO
SUBTTL Data Structures:
COMMENT ⊗
PROCESS BLOCK:
Process pointer addresses last word in block
STACK: < n words of stack>
IOWD -n,STACK
XWD <queue datum>,<user number or -1>
XWD <next in queue>,<address of saved acs>
⊗;
↓%LINK ←← 0
↓%PACS ←← 0
↓%USER ←← -1
↓%DATUM ←← -1
↓%PDLIO ←← -2
↓%PDLSZ ←← PROCSZ-3
COMMENT ⊗
QUEUE BLOCK:
<first element of queue>
<last element of queue>
<number of entries in queue>
Queue elements are linked thru the left half of zeroth word of each element
⊗;
SUBTTL START - Initialization and Main Loop
LOC 124
REEADR
RELOC
$BGNET↑:
START:
REEADR: MOVE TAC,[SIXBIT/NETGRF/]
SETNAM TAC,
RESET
MOVE P,PDLIOWD ;Set up PDL
SKIPE DEBUG ;Don't RESET if detached (lose letter)
RESET ;Flush old I/O
SETZM BEGZER ;Zero storage for repeatability
MOVE TAC,[XWD BEGZER,BEGZER+1]
BLT TAC,ENDZER
SETOM LOKCNT ;Initialize lock count
MOVEI TAC,51 ;Default socket
MOVEM TAC,LSOCKT+U.ICP
PJOB TAC, ;Remember our job number
MOVEM TAC,THISJOB
; HRLZM TAC,NXTSOC ;Next socket to use for ICP
MOVEI TAC,INTSER ;Set up interrupt vector
MOVEM TAC,JOBAPR↑
HLRO TAC,JOBSYM↑ ;Save symbols if DDT is loaded
SUB TAC,JOBSYM
MOVN TAC,TAC
;;; SKIPN JOBDDT
;;; HLRZ TAC,JOBSA↑ ;Core down
MOVEM TAC,OLDFF
;;; CORE TAC,
;;; JFCL
SETOM JOBFF↑ ;To catch system, trying to make buffers.
SETZ TAC,
GETNAM TAC, ;Same name as segment?
SEGNAM TAC2,
CAMN TAC,TAC2
JRST [ SETZ TAC, ;Yes, flush spurious segment
CORE2 TAC,
JFCL
JRST .+1]
MOVEI TAC,=5 ;Number of times DRYROT may be called
MOVEM TAC,LOSCNT ;before giving up the ghost
MOVSI TAC,400000 ;Init. user table
ASH TAC,1-NUSERS
MOVEM TAC,USEMAP
MOVSI TAC,'IMP' ;Get IMP's buffer size
BUFLEN TAC,
CAILE TAC,PROCSZ-2 ;Bigger than a process block?
MOVEI TAC,PROCSZ-2 ;Yes, use latter size
MOVEM TAC,IMPSIZ
MOVSI TAC,'TTY' ;Get TTY's buffer size
BUFLEN TAC,
CAILE TAC,PROCSZ-2 ;Bigger than a process block?
PUSHJ P,DRYROT ;HELP!!!! (SOMETHING BETTER HAS TO BE DONE HERE)
MOVEM TAC,TTYSIZ
IFN CHKSW,<
PUSHJ P,SETCHK ;Set checksum
>;IFN CHKSW
SETOM DEBUG ;Set debug flag if not detached
GETLIN DEBUG
AOSN DEBUG
JRST[ PUSH P,[' TVR']
PUSH P,[[ASCIZ/;; NETGRF started.
/]]↔ PUSHJ P,BLAST↑
JRST .+2]
OUTSTR[ASCIZ/
SU-AI Network Graphics Server
/]
;Lastly, enable interrupt (will probably get one immediately).
INTMSK [¬(INTPTI!INTPTO)]
MOVE TAC,[IFN CHKSW,<INTPAR!>INTMAIL!INTTTI!INTIMS!INTPTO!INTPTI!INTINP]
INTENB TAC,
; IWKMSK [¬(INTTTI)]
SETO U, ;System task
PUSH P,[USECHK]
PUSH P,[5*=60*=60] ;Check back in five minutes to see if anyone's
PUSHJ P,DELAY ;home
IFN DEBPRC,<
skipn debug
jrst skptst
PUSH P,[TEST2]
PUSH P,[2*=60] ;Check back in five minutes to see if anyone's
PUSHJ P,DELAY ;home
PUSH P,[TEST3]
PUSH P,[5*=60] ;Check back in five minutes to see if anyone's
PUSHJ P,DELAY ;home
PUSH P,[TEST1]
PUSH P,[1*=60] ;Check back in five minutes to see if anyone's
PUSHJ P,DELAY ;home
PUSH P,[TEST4]
PUSH P,[10*=60] ;Check back in five minutes to see if anyone's
PUSHJ P,DELAY ;home
skptst:
>;IFN DEBPRC
MOVEI U,U.ICP ;Set User number for NEWICP
PUSH P,[NEWICP] ;Start up ICP listen
PUSHJ P,SCHED
SETO U, ;System.
SETO TAC, ;Are we detached?
GETLIN TAC
AOJN TAC,MAIN ;No
REPEAT 0,<
;Set up to send letter to logger.
SETZ TAC,
GETNAM TAC, ;Tell the logger our name
MOVEM TAC,THISNAM
MOVEI TAC,2*=60 ;Wait two minutes before giving up.
MOVEI TAC2,1 ;Number of seconds to sleep for mail
; Send a letter to the logger
MAILOG: SKPSEN [SIXBIT/LOGGER/ ;Yes, tell logger where we are
THISJOB]
JRST [ SLEEP TAC2, ;Wait for logger's mailbox to empty
SOSG TAC,MAILOG ;But give up after a while
EXIT ]
SKIPA
EXIT ;Too many or too few LOGGER's. Give up.
>;REPEAT 0
PUSH P,['NETGRF']
PUSH P,[[ASCIZ/;; NETGRF started.
/]]↔ PUSHJ P,BLAST↑
MAIN: PUSH P,[PRIQUE] ;Run any processes in priority queue
PUSHJ P,DEQUE
JUMPN RET,MAIN2
PUSH P,[RUNQUE] ;Then the run queue
PUSHJ P,DEQUE
JUMPE RET,WAITER
MAIN2: PUSH P,RET ;Get ready to run him
PUSHJ P,RUNPROC
JRST MAIN ;Back for more
WAITER: SETO TAC, ;Watch the timing race
IMSKCR TAC
SKIPE RUNWAI ;Anything waiting to run?
JRST [
; INTMSK TAC ;Yes, Restore interrupts
; JRST MAIN ] ;and run it
skipn runque ;Bug check
skipe prique
JRST [ INTMSK TAC ;and run it
JRST MAIN ]
pushj p,dryrot
setzm runwait
jrst .+1]
IMSTW TAC ;Re-enable and wait for interrupt to wake us
JRST MAIN
ARRAY INTBUF[6]
SUBTTL EXIT - Change name and stop
DOEXIT: MOVE TAC,[SIXBIT/HLTGRF/]
SETNAM TAC,
PUSHJ P,LOGIT
XWD 7,[ASCIZ/Exiting.
/]↔ 0
CALLI 12
SUBTTL RDMAIL - Read the Mail
BEGIN RDMAIL
; Start off at interrupt level in order to stop display generating
; programs fast enough so that they don't modify their display (we
; hope).
ASCID/NTMAI/
↑RDMAIL:SRCV INLET ;Read the mail
JRST NOMAIL
RDMAI1: MOVE A,INLET+3 ;Who does it claim to be from?
IFN GRFPRO,<
CAMN A,[SIXBIT/UPGIOT/] ;Somebody wanting to do display output
JRST SNDIII
>;IFN GRFPRO
PUSHJ P,[PUSHJ P,SCHED ;The rest may as well be done at user level
JRST INTDIS ]
SKIPE DEBUG
OUTSTR[ASCIZ/Reading the mail.../]
CAMN A,[SIXBIT/DEBUG?/] ;LOGGER perhaps?
JRST NEWCON ;Yes, open new connection
CAMN A,[SIXBIT/DETJOB/] ;Unhang a PTY?
JRST CHGJOB ; Yes, go do it!
CAMN A,[SIXBIT/D.KING/] ;Dave King format?
JRST CHGJOB ; Yes, go do it!
CAMN A,[SIXBIT/STATUS/] ;Status?
JRST XSTAT
SKIPN DEBUG
jrst [
pushj p,LOGIT
XWD 7,[asciz/Garbage in mail box: /]
XWD 6,INLET+3
0
jrst .+1]
SKIPE DEBUG
OUTSTR[ASCIZ/Garbage!
/]
SKPME INLET
JRST NOMAIL
PUSH P,[RUNQUE]
PUSHJ P,RESCHED ;Give others a chance before reading more
NOMAIL: SKIPE DEBUG
OUTSTR[ASCIZ/Gee, i thought i had some mail. Oh, well
/]
↑MAILOK:TURNON [INTMAIL] ;Let mail interrupts happen again
POPJ P,
BEND RDMAIL
; - Letter format
COMMENT ⊗
DEBUG? - Request for connection from LOGGER
local socket # (32 bits, right adjusted)
foreign socket # (32 bits, right adjusted)
host-link number (16 bits, right adjusted)
sixbit /DEBUG?/ if telnet is being debugged
sixbit /<name of the host>/ (left-justified)
DETJOB - Detach job from owned PTY
Job number of requestor
<ignored>
<ignored>
sixbit/DETJOB/
PTY number to be detached from
D.KING - Enable Dave King format
Job number of requestor
<ignored>
<ignored>
sixbit/D.KING/
PTY number to be enabled
Interrupt bit to send on completion ;5
STATUS - Send status information to arbitrary teletype
Job number of requestor
<ignored>
<ignored>
sixbit/STATUS/
TTY number to be typed upon
Interrupt bit to send on completion ;5
UPGIOT - Handle display instruction
Job number of caller ;0
Address of display buffer ;1
POG number ;2
SIXBIT/UPGIOT/ ;3
PTY number ;4
Interrupt bit to send on completion ;5
⊗;
SUBTTL NEWICP - Start up new ICP
BEGIN NEWICP
;Initial connection protocol:
;;The following is done by the LOGGER
; listen(local = L, size = 32)
; [wait for connection]
; send(socket = L, data = S)
; close(socket = L)
;;Server program
; init(local = S, foreign = U+3, size = Bu) ;The foreign site specifies Bu
; init(local = S+1, foreign = U+2, size = Bs) ;We specify Bs
;
;init(local = S, foreign = U+3, size = Bu) ;The foreign site specifies Bu
;
↑NEWICP:
caie u,u.icp ;Check user number
pushj p,dryrot ; LOSE!
INIT U.ICP,17 ;Use dump mode for ICP listen
SIXBIT/IMP/
0
JRST NOIMP ;Lose!
MOVSI TAC,400000⊗(-U.ICP) ;Mark IMP connection as in use
ORM TAC,IMPMAP
PUSH P,LSOCKT+U.ICP ;Contact socket
PUSH P,[0] ;Doing LISTEN!
PUSH P,[0]
PUSH P,[=32] ;Bytesize
PUSHJ P,NETOPN
; MOVEI 3,=8 ;Get next socket to use
; ADD 3,NXTSOC ;After incrementing for next guy
; EXCH 3,NXTSOC
MOVEI 2,21 ;Gensym a socket
MTAPE U.ICP,2
PUSH P,3 ;Save socket on stack
LSH 3,4
OUTPUT U.ICP,[IOWD 1,3 ;Send new socket number
0]
MOVEI 1,7 ;Put status into ACs
MOVE 3,LSOCKT+U.ICP
MTAPE U.ICP,1
;Fake letter from LOGGER as kludge
;; local socket # (32 bits, right adjusted)
;; foreign socket # (32 bits, right adjusted)
;; host-link number (16 bits, right adjusted)
;; sixbit /DEBUG?/ if telnet is being debugged
;; sixbit /<name of the host>/ (left-justified)
TURNOFF [INTMAIL] ;Disable mail interrupts for fake letter
MOVEM 7,INLET+2
POP P,INLET ;Local socket number
MOVEM 6,INLET+1 ;Set foreign socket number
;*** Kludge: Just host number for now ****
MOVE 1,[SIXBIT/@@@@@@/]
MOVEM 1,INLET+4
PUSH P,[POINT 6,INLET+4] ;Make byte pointer on stack
MOVSI 3,(<IDPB 1,>)
HRRI 3,(P)
MOVEI 1,"#"
XCT 3
LDB 1,[POINT 8,2,35-8]
PUSH P,1
PUSH P,[=10]
PUSH P,3
PUSHJ P,WRINT
MOVE 1,[SIXBIT/@@@@@@/]
XORM 1,INLET+4 ;Cheap ASCII to SIXBIT!
POP P,(P)
;*** End kludge: Just host number for now ****
PUSH P,[NEWCON] ;Make new connection
PUSHJ P,SCHED
PUSH P,[CLOICP] ;Wait a bit and then close
PUSH P,[=15]
PUSHJ P,DELAY
POPJ P,
;Close ICP and get ready for another connection
↑CLOICP:SETZ A, ;No message
PUSHJ P,KLUSER ;Flush ICP connection and any stray processes
JRST NEWICP ;Start new ICP
NOIMP: PUSH P,[NEWICP]
PUSH P,[3*=60] ;Wait awhile and try again
PUSHJ P,DELAY
POPJ P,
BEND NEWICP
SUBTTL NEWCON - Make new connection
BEGIN NEWCON
COMMENT $ Format of letter from LOGGER
;INLET: local socket # (32 bits, right adjusted)
; foreign socket # (32 bits, right adjusted)
; host-link number (16 bits, right adjusted)
; sixbit /debug?/ if telnet is being debugged
; sixbit /<name of the host>/ (left-justified)
$;
MLS←←0
MFS←←1
HOSLNK←←2
DEBUGQ←←3
HOSNAM←←4
↑NEWCON:PUSHJ P,GTUSID
SKIPN DEBUG
jrst [ pushj P,LOGIT↑
XWD 7,[asciz/Connection requested from /]
XWD 6,INLET+HOSNAM
XWD 7,[ASCIZ/Assigned user #/]
XWD 8,U
0
JRST NEWCO1]
OUTSTR[ASCIZ/Request from host /]
PUSH P,INLET+HOSNAM
PUSHJ P,TYPSIX
OUTSTR[ASCIZ/
Host #/]
MOVE TAC,INLET+HOSLNK
PUSH P,TAC
PUSHJ P,TYPDEC
OUTSTR[ASCIZ/, Foreign Socket #/]
PUSH P,INLET+MFS
PUSHJ P,TYPOCT
OUTSTR[ASCIZ/, Local Socket #/]
PUSH P,INLET+MLS
PUSHJ P,TYPOCT
OUTSTR[ASCIZ/, Server User #/]
PUSH P,U
PUSHJ P,TYPDEC
OUTSTR CRLF
NEWCO1: MOVEI A,3 ;Make index into header
IMULM U,A
MOVSI TAC,OUTHDR(A)
HRRI TAC,INHDR(A)
ENTERLOCK IMMLOK
MOVEM TAC,IMPBLK+2 ;Tell system where our buffers are
MOVEI TAC2,10
MOVEM TAC2,IMPBLK
MOVE TAC2,[OPEN 000,IMPBLK] ;Init IMP
DPB U,[POINT 4,TAC2,12]
XCT TAC2 ;OPEN CHAN,IMPBLK
JRST [ MOVEI A,[ASCIZ/Can't INIT IMP. Assuming letter was a fake.
/]↔ LEAVELOCK IMMLOK
PUSHJ P,MAILOK
JRST KLUSER ]
LEAVELOCK IMMLOK
MOVEI TAC,=8
DPB TAC,[POINT 6,INHDR+1(A),11] ;Set byte size
DPB TAC,[POINT 6,OUTHDR+1(A),11]
MOVEM TAC,BYTSIZ(U)
PUSH P,[2] ;Buffer buffers for IMP
PUSH P,IMPSIZ
PUSHJ P,MKRBUF
MOVEM RET,INHDR(A) ;Make header for system input
PUSH P,[2]
PUSH P,IMPSIZ
PUSHJ P,MKRBUF
MOVEM RET,OUTHDR(A) ;Make header for system output
MOVSI TAC2,(<OUTPUT 000,>) ;Initial output to set up buffers
DPB U,[POINT 4,TAC2,12]
XCT TAC2 ;OUTPUT CHAN,
SOS OUTHDR+2(A) ;Fix byte count
MOVEI TAC,3 ;Save initial status
IMULM U,TAC
MOVEI A,2
ADD TAC2,[<MTAPE 000,A>-<OUTPUT 000,>]
XCT TAC2 ;MTAPE CHAN,[GET_STATUS...]
MOVEM B,IMPST1(TAC)
MOVEM C,IMPST1+1(TAC)
ADD TAC2,[[17 ;Set timeouts
BYTE (6) =1,0,=30,=63,0]-A]
; Bytes mean: CLS,RFNM,ALLOC,RFC,INP
XCT TAC2 ;MTAPE CHAN,[SET_TIMOUTS...]
MOVE TAC2,[GETSTS 000,IMPST1+2(TAC)] ;Get I/O status
DPB U,[POINT 4,TAC2,12]
XCT TAC2 ;GETSTS CHAN,IMPST1I+2(A)
MOVSI TAC,400000 ;Mark IMP connection as in use
MOVN TAC2,U
ROT TAC,(TAC2)
ORM TAC,IMPMAP
SETZM PROMAP(U)
;Initial connection protocol:
;;The following is done by the LOGGER
; listen(local = L, size = 32)
; [wait for connection]
; send(socket = L, data = S)
; close(socket = L)
;;Server program
; init(local = S, foreign = U+3, size = Bu) ;The foreign site specifies Bu
; init(local = S+1, foreign = U+2, size = Bs) ;We specify Bs
;
;init(local = S, foreign = U+3, size = Bu) ;The foreign site specifies Bu
MOVE TAC2,INLET+MLS ;Set local socket
MOVEM TAC2,LSOCKT(U)
PUSH P,TAC2
MOVE TAC2,INLET+HOSLNK ;Set host number
MOVEM TAC2,HOSTNU(U)
PUSH P,TAC2
MOVE TAC2,INLET+MFS ;Set foreign socket
MOVEM TAC2,FSOCKT(U)
ADDI TAC2,3
PUSH P,TAC2
PUSH P,[8] ;Set byte size
MOVE TAC2,INLET+HOSNAM ;Copy host name from letter into internal tables
MOVEM TAC2,HOSTNA(U)
LSH TAC2,-14
MOVEM TAC2,WHRTAB(U) ;Set Host name part of WHERE table
IFE NUSERS-1,< ;If one user version, set name to G-XXXX
TLO TAC2,'G- '
SETNAM TAC2,
>
PUSHJ P,MAILOK
PUSH P,[OPNCHK] ;Start process to flush if no connection
PUSH P,[1*=60*=60] ;in one minute
PUSHJ P,DELAY
PUSHJ P,NETOPN ;Open network connection
JRST CONEST ;Connection established
BEND NEWCON
SUBTTL CONEST - Connection Established.
BEGIN CONEST
↑CONEST:
SKIPN DEBUG
JRST CONES2
OUTSTR[ASCIZ/TELNET connection open for user #/]
PUSH P,U
PUSHJ P,TYPDEC
OUTSTR CRLF
CONES2: MOVE TAC,[MTAPE 000,[15↔3↔0↔0]] ;Give him default allocation
DPB U,[POINT 4,TAC,12]
XCT TAC ;MTAPE CHAN,[ALLOC↔3↔0↔0]
IFN DKPRO,<
SETZM DKFLAG(U) ;Initialize D. King kludge
SETOM DKIACT(U)
SETZM DKIACT+NUSERS(U)
SETZM DKOACT(U)
SETZM DKIHI(U)
SETZM DKESCF(U)
>;IFN DKPRO
PUSH P,[[ASCIZ*SU-AI Network Graphics Server.
Please type "HELP NETGRF<return>".
*]]↔ PUSHJ P,IMPSTR
PUSHJ P,MKPBLK ;Get another process block
SUBI RET,PROCSZ-1 ;Point to first word
MOVEM RET,PTOBUF(U) ;Save it
PTYGET PTYNUM(U) ;Get a PTY
JRST [ MOVEI A,[ASCIZ/No psuedoteletypes available, sorry.
/]↔ PUSH P,A ;What a pity, no PTY
PUSHJ P,IMPSTR
PUSHJ P,LOGIT
XWD 7,[ASCIZ/No PTYs available!!!/]
0
JRST KLUSER ] ;Flush him!
ACCTIM TAC, ;Include date and time
PUSH P,TAC
PUSH P,[PUSHJ P,IMPOCHR]
PUSHJ P,WRDAYT↑
PUSH P,[[ASCIZ/ TTY/]] ;Tell user his/her TTY number
PUSHJ P,IMPSTR
PUSH P,PTYNUM(U)
HRRZS (P)
PUSH P,[=8]
PUSH P,[PUSHJ P,IMPOCHR]
PUSHJ P,WRINT↑
IFN GRFPRO,<
PUSH P,[ [ASCIZ/ *GICP*/] ]
PUSHJ P,IMPSTR
MOVE TAC,LSOCKT(U)
ADDI TAC,2
PUSH P,TAC
PUSH P,[=11]
PUSH P,[PUSHJ P,IMPOCHR]
PUSHJ P,WROCT↑
>;IFN GRFPRO
MOVBI TAC,PROBIT(→$SGA)+PROBIT(→$ECHO) ;Tell other end we will suppress
;go ahead and echoing
ORM TAC,PROMAP(U)
PUSH P,[[BYTE (8) $IAC,$WILL,$SGA,$IAC,$WILL,$ECHO,15,12,".",0]]
PUSHJ P,IMP8STR
SKIPE DEBUG
OUTSTR[ASCIZ/ [WILL 3]/]
MOVE A,PTYNUM(U) ;Tell everyone it's a net connection
PTGETL A
;; TLO B,FULTWX!FCS!XON
printx PTY needs its bits setup more carefully, i think. It's changed in N years.
TLO B,FULTWX!XON
;; move tac,hostnum(u) ;UCB doesn't insert LF after CR!
;; cain tac,=98
;; tlz b,fultwx!xon
PTSETL A
MOVSI TAC,034400(A)
HRROI B,TAC
TTYSET B,
DPB A,[POINT 12,WHRTAB(U),11] ;Set PTY number entry in WHERE table
PUSHJ P,OUTWHR ;Force out WHERE table for MAIL, FINGER, etc.
COMMENT ⊗ (From LISTNR[CSP,SYS])
LISTNR uses the FULTWX bit to control the state of echoing of the PTY
because the NOECHO bit in the TTY DDB is used by the program connected
to the PTY (and hence conflicts) and, anyway, it only works when the
PTY is not in monitor mode. But the FULTWX bit doesn't quite do the
right thing altogether either. It has the problem that line feeds
that the system inserts still get echoed. To fix that, the XON bit
is turned on so that the system won't insert line feeds and the
LISTNR inserts its own line feeds.
⊗
SETZM PTOFUL(U) ;Mark PTY output buffer as empty (full if
;non-negative)
SETZM ALLFUL ;We have an empty buffer now
TURNON [INTINP!INTPTI!INTPTO]
IFN GRFPRO,<
ADDI U,3 ;We're setting up graphs part now
PUSH P,[GRFLIS] ;Make process to handle graphics connection
PUSHJ P,SCHED
SUBI U,3 ;Reset user ID
>;IFN GRFPRO
POPJ P, ;Done, we can leave now
;Check to see if connection was successfully opened. This really shouldn't
;be necessary as the connection should time out, but since IMPSER is not
;likely to get fixed soon, it is better to check so as not to leave
;spurious jobs and connections lying around.
↑OPNCHK:SKIPE PTYNUM(U) ;PTY assigned?
JRST PREXIT ; Yes, assume opened
PUSH P,[=60] ;Wait a second in case already flushing
PUSHJ P,POSTPONE
MOVEI A,[ASCIZ/Connection timed out.
/]↔ JRST KLUSER
SUBTTL GRFLIS - Set up to listen from graphics connection
;Falls thru from CONEST
IFN GRFPRO,<
;Get ready to listen for graphics connection
↑GRFLIS:
MOVEI A,3 ;Make index into header
IMULM U,A
MOVSI TAC,OUTHDR(A)
HRRI TAC,INHDR(A)
ENTERLOCK IMMLOK ;We need to use the mtape block
MOVEM TAC,IMPBLK+2 ;Tell system where our buffers are
MOVEI TAC2,10
MOVEM TAC2,IMPBLK
MOVE TAC2,[OPEN 10,IMPBLK] ;Init IMP
DPB U,[POINT 4,TAC2,12]
XCT TAC2 ;OPEN CHAN,IMPBLK
JRST [ MOVEI A,[ASCIZ/Can't INIT IMP!
/]↔ LEAVELOCK IMMLOK
JRST KLUSER ]
LEAVELOCK IMMLOK
MOVEI TAC,=8
DPB TAC,[POINT 6,INHDR+1(A),11] ;Set byte size
DPB TAC,[POINT 6,OUTHDR+1(A),11]
MOVEM TAC,BYTSIZ(U)
PUSH P,[2] ;Buffer buffers for IMP
PUSH P,IMPSIZ
PUSHJ P,MKRBUF
MOVEM RET,INHDR(A) ;Make header for system input
PUSH P,[2]
PUSH P,IMPSIZ
PUSHJ P,MKRBUF
MOVEM RET,OUTHDR(A) ;Make header for system output
MOVSI TAC2,(<OUTPUT 000,>) ;Initial output to set up buffers
DPB U,[POINT 4,TAC2,12]
XCT TAC2 ;OUTPUT CHAN,
SOS OUTHDR+2(A) ;Fix byte count
MOVEI TAC,3 ;Save initial status
IMULM U,TAC
MOVEI A,2
ADD TAC2,[<MTAPE 000,A>-<OUTPUT 000,>]
XCT TAC2 ;MTAPE CHAN,[GET_STATUS...]
MOVEM B,IMPST1(TAC)
MOVEM C,IMPST1+1(TAC)
ADD TAC2,[[17 ;Set timeouts
BYTE (6) =3,=0,=30,0,0]-A]
; Bytes mean: CLS,RFNM,ALLOC,RFC,INP
XCT TAC2 ;MTAPE CHAN,[SET_TIMOUTS...]
MOVE TAC2,[GETSTS 000,IMPST1+2(TAC)] ;Get I/O status
DPB U,[POINT 4,TAC2,12]
XCT TAC2 ;GETSTS CHAN,IMPST1I+2(A)
MOVSI TAC,400000 ;Mark IMP connection as in use
MOVN TAC2,U
ROT TAC,(TAC2)
ORM TAC,IMPMAP
MOVEI TAC,MTSIZE ;Make pointer into MTAPE blocks
IMULM U,TAC
ADDI TAC,MTBLKS
;Graphics initial connection protocol:
;;Server program
; listen(local = S+2, size = Bu)
;
;listen(local = S, foreign = U+3, size = Bu) ;The foreign site specifies Bu
MOVE TAC2,LSOCKT-NUSERS(U) ;Get local socket number
ADDI TAC2,2
MOVEM TAC2,LSLOC(TAC)
PUSH P,TAC2 ;Set local socket
PUSH P,[0] ;No site
PUSH P,[0] ;Or socket specified
PUSH P,[8] ;8 bit connection
PUSHJ P,NETOPN ;Open connections
; JRST GRFEST
;Falls thru to GRFEST
>;IFN GRFPRO
BEND CONEST
SUBTTL GRFEST - Graphics Connection Established!
;Falls thru from GRFLIS
IFN GRFPRO,<
BEGIN GRFEST
↑GRFEST:
SKIPN DEBUG
JRST CONES2
OUTSTR[ASCIZ/Graphics transmit side open for user #/]
MOVE A,U
SUBI A,NUSERS
PUSH P,A
PUSHJ P,TYPDEC
OUTSTR CRLF
CONES2: MOVE TAC,[MTAPE 000,[15↔3↔0↔0]] ;Give him default allocation
DPB U,[POINT 4,TAC,12]
XCT TAC ;MTAPE CHAN,[ALLOC↔3↔0↔0]
; We'll send him/her a greeting when we know what capabilities the
; terminal has.
IFN DKPRO,<
SKIPE DKFLAG(U) ;D. King format in use?
JRST [
MOVEI A,[ASCIZ/Attempt to set up graphics channel
while D. King format active! User #/]
JRST KLUSER ] ;Flush graphics channel
SETOM DKIACT(U) ;Enable his/her graphics channel
↑DKGINI:
>;IFN DKPRO
SETZM DPYUSE-NUSERS(U)
SETOM DPYFLG-NUSERS(U) ;We're ready to do display I/O
MOVBI TAC,GREBIT+INQBIT
ANDCAM TAC,FLAGS-NUSERS(U)
MOVEI RET,$INQUI
PUSHJ P,IMPOCHR
JRST IMPOUT ;Send to IMP and return
BEND GRFEST
>;IFN GRFPRO
SUBTTL SNDGRE - Send Graphics Greeting
IFN GRFPRO,<
BEGIN SNDGRE
;
↑SNDGRE:
SKIPN DEBUG
JRST [ MOVE TAC,HOSTNA-NUSERS(U)
PUSHJ P,LOGIT
XWD 7,[ASCIZ/Greeting sent to /]
XWD 6,TAC
0
JRST .+1 ]
PUSHJ P,GET1K ;Get somewhere to put the display buffer
PUSH P,RET ;Save address on stack to release later
ENTERLOCK C17LOK ;Get channel 17
INIT 17,17 ;Reading GREET.DPY[NET,TVR]
SIXBIT/DSK/
0
JRST LOSE
MOVS TAC,[XWD A,[SIXBIT/GREET/
SIXBIT/DPY/
0
SIXBIT/NETTVR/]]
BLT TAC,D
LOOKUP 17,A
JRST LOSE
SETZ D,
MOVE C,(P)
HRLI C,-1024
SUBI C,1
INPUT 17,C
RELEASE 17,
LEAVELOCK C17LOK ;Release interlock on channel 17
MOVEI C,2
ADD C,(P)
MOVEM C,-2(C)
MOVEI TAC,=1024-2 ;Check display buffer size
CAMG TAC,-1(C)
MOVEM TAC,-1(C) ;Force it to fit!
SUBI C,2
PUSH P,THISJOB
PUSH P,C
PUSH P,[1]
PUSHJ P,IIISIM
SNDRET: PUSHJ P,REL1K ;Release the display buffer
POPJ P,
LOSE: RELEASE 17,
LEAVELOCK C17LOK ;Release channel 17
SKIPE DEBUG
OUTSTR[ASCIZ/Couldn't send greeting.
/]↔ JRST SNDRET
BEND SNDGRE
>;IFN GRFPRO
SUBTTL SNDIII - Send III buffer
IFN GRFPRO,<
BEGIN SNDIII
;
; Format of letter from user program
;
;LETTER: Job number of caller ;0
; Address of display buffer ;1
; POG number ;2
; SIXBIT/UPGIOT/ ;3
; PTY number ;4
; Interrupt bit to send on completion ;5
;
↑SNDIII:PUSH P,INLET+4 ;Find user number from PTY number
PUSHJ P,FNDPTY
JRST MAILOK ;Not found, just ignore letter.
SETO TAC,
CAMN TAC,INLET+5
JRST [ MOVE TAC,PTYNUM(U) ;If -1 then halt PTY
MOVEI TAC2,1 ;HALT
PTJOBX TAC
JFCL ;Ignore error routine
JRST .+1 ]
PUSHJ P,[PUSHJ P,SCHED
JRST INTDIS]
SKIPN DEBUG
JRST NOTDEB
OUTSTR[ASCIZ/UPGIOT, User #/]
PUSH P,U
PUSHJ P,TYPDEC
OUTSTR[ASCIZ/ POG #/]
PUSH P,INLET+2
PUSHJ P,TYPDEC
OUTSTR[ASCIZ/
/]
NOTDEB: ADDI U,NUSERS ;We're doing graphics now
PUSH P,INLET ;Save job number for later notification
PUSH P,INLET+5 ;And reply code
PUSH P,INLET ;Args to IIISIM
PUSH P,INLET+1
PUSH P,INLET+2
PUSHJ P,MAILOK ;Release mail box before calling IIISIM!
PUSHJ P,IIISIM ;Now, send it out
SUBI U,NUSERS ;We're done with graphics
SETO TAC,
CAMN TAC,(P)
JRST [ MOVE TAC,PTYNUM(U) ;If -1 then continue PTY
MOVEI TAC2,2 ;CONT
PTJOBX TAC
JFCL
JFCL
JRST CONTED ]
INTIPI -1(P) ;Notify calling process
JFCL ;Ignore errors for now
CONTED: SUB P,[XWD 2,2] ;Flush stack
POPJ P,
BEND SNDIII
>;IFN GRFPRO
SUBTTL USECHK - Check to see if anyone's here
BEGIN USECHK
↑USECHK:
; PUSH P,[INTIMS] ;Turn off IMP change interrupts
; IMSKCR (P) ;(Saving old mask)
ENTERLOCK IMCLOK ;Enter interlock against IMP change
PUSHJ P,IMPCHG ;Check everyone's status, in case it was missed
; IMSKST (P) ;Restore IMP interrupts
LEAVELOCK IMCLOK ;Leave interlock against IMP change
; POP P,(P) ;Flush old mask from stack
PUSH P,[RUNQUE]
PUSHJ P,RESCHED ;Run any processes invoked by IMPCHG
SKIPN USERS ;Any users?
jrst [ move 1,impmap
tdnn 1,-1⊗(36-grfmul*nusers) ;Check this, too
EXIT ;No, bye.
pushj p,logit
xwd 7,[asciz/USERS overSOS'ed.
USERS = 0, IMPMAP = /]
xwd =14,IMPMAP
xwd 7,[asciz/ USEMAP = /]
xwd =14,USEMAP
0
JRST .+1]
PUSH P,USERS ;Print number of users.
PUSHJ P,TYPDEC
OUTSTR[ASCIZ/ users.
/]↔
IFN CHKSW,<
PUSHJ P,SYSCHK
>;IFN CHKSW
PUSH P,[USECHK] ;Start up again in two minutes
PUSH P,[2*=60*=60]
PUSHJ P,DELAY
POPJ P,
BEND USECHK
IFN DEBPRC,<
TEST1: OUTCHR["1"];
POPJ P,
TEST2: OUTCHR["2"];
POPJ P,
TEST3: OUTCHR["3"];
POPJ P,
TEST4: OUTCHR["4"];
POPJ P,
>;IFN DEBPRC
SUBTTL STATUS - Print status of NETGRF
BEGIN STATUS
;Status obtained when via mail
↑XSTAT: PUSH P,INLET ;Make block with which to send interrupt
PUSH P,INLET+5
MOVE TAC,INLET+4 ;Get name of TTY
PUSHJ P,MAILOK ;Release mailbox
PUSHJ P,STAT1 ;Use that as TTY number
INTIPI -1(P) ;Notify calling process
JFCL ;Ignore errors for now
SUB P,[XWD 2,2] ;Flush stack
POPJ P,
;Status obtained when typing <esc>I
↑STATUS:MOVSI TAC,'TTY'
STAT1: MOVEM TAC,STSDEV
MOVEI 1,=80 ;Get byte count
MOVEM 1,STSCNT
PUSHJ P,FLUSH ;Force setup of buffers
CALL WRASCZ,<[[ASCIZ/Status of NETGRF on /]]>,STSOP
ACCTIM RET, ;Include date and time
CALL WRDAYT↑,RET,STSOP
CALL WRASCZ,<[[ASCIZ/
/]]>,STSOP
CALL WRINT,USERS,<[=10]>,STSOP
CALL WRASCZ,<[[ASCIZ/ users.
Active processes:
Queue User# PBlock Datum PC
/]]>,STSOP
MOVEI E,BEGQUE ;Start looking at queues
QUECHK: SKIPN A,(E) ;Anything there?
JRST QEMPTY
CALL WRSYMB↑,E,STSOP ;First time thru, print name
SKIPA 1,[" "] ;Then print <tab>
QLOOP: XCT STSOP
XCT STSOP
HRRE 1,%USER(A) ;Print user number
CALL WRINT,1,<[=10]>,STSOP
MOVEI 1," " ;Then print <space>
XCT STSOP
CALL WROCT,A,<[6]>,STSOP ;Print Process Block number
MOVEI 1," " ;Then print <space>
XCT STSOP
HLRE 1,%DATUM(A) ;Print datum number
CALL WRINT,1,<[8]>,STSOP
MOVEI 1," " ;Then print <tab>
XCT STSOP
HRRZ 1,%PACS(A) ;Get address of ACs
JUMPE 1,QFOO
HRRZ 1,-1(1) ;Print PC
CALL WRSYMB↑,1,STSOP
QFOO: CALL WRASCZ,<[[ASCIZ/
/]]>,STSOP
HLRZ A,%LINK(A) ;Pick up next block
CALL RESCHED,<[RUNQUE]>
MOVEI 1," " ;Maybe print another <tab>
JUMPN A,QLOOP
QEMPTY: ADDI E,QUESIZ ;Advance to next queue
CAIGE E,BEGQUE+NQUES*QUESIZ ;Done yet?
JRST QUECHK ;No, print next one
PUSHJ P,FLUSH ;Flush out input buffer
TURNON [INTTTI] ;Re-enable <esc>I
POPJ P,
STSOP: PUSHJ P,STSPUT ;Opcode to pass to convertion routines
;Output a character to arbitrary TTY
STSPUT: JUMPE 1,CPOPJ ;Don't even look at nulls!
SOSGE STSCNT ;Room in buffer?
PUSHJ P,FLUSH1 ;No, flush output buffer first
IDPB 1,STSPTR ;Stick it in buffer
CPOPJ: POPJ P,
;Flush output buffer
FLUSH: SOS STSCNT ;Compensated later
PUSHJ P,FLUSH1
AOS STSCNT
POPJ P,
FLUSH1: PUSH P,1 ;Save an AC
MOVE 1,[POINT 7,STSBUF] ;Point at next buffer
MOVEM 1,STSPTR
MOVEM 1,STSDEV+1 ;Set pointer for TTYMES
MOVEI 1,=80-1 ;Get byte count
SUB 1,STSCNT
ADDM 1,STSCNT ;Reset byte count
RETRY: DPB 1,[POINT 12,STSDEV+1,17] ;Store it away for TTYMES
JUMPE 1,NONE
MOVEI 1,STSDEV ;Output to arbitrary teletype
NULMES 1,
JUMPN 1,[PUSH P,1 ;Failed, advance byte pointer to account
PUSH P,2 ;for characters actually sent
CALL POSTPONE,<[5]>;Postpone action a bit to give system time to work
LDB 1,[POINT 12,STSDEV+1,17] ;Pick up old byte count
SUB 1,-1(P) ;Calculate number of bytes to advance
IDIVI 1,5 ;Seperate into words and bytes
ADDM 1,STSDEV+1 ;Increment word part
JUMPE 2,NOADV
MOVEI 1,700 ;Remake 7 bit byte pointer
DPB 1,[POINT 12,STSDEV+1,17]
ADVPTR: IBP STSDEV+1
SOJG 2,ADVPTR
NOADV: POP P,2
POP P,1
JRST RETRY ]
NONE: POP P,1
POPJ P,
INTEGER STSCNT,STSPTR
ARRAY STSDEV[2],STSBUF[=80/5]
BEND STATUS
SUBTTL CHGJOB - Change job paramenters
;DETJOB - Detach job from hung net connection
;D.KING - Specify D. King's format
;
↑CHGJOB:MOVE C,A ;Save command
MOVE A,INLET+4 ;PTY number to be detached from
MOVE B,INLET ;Job number of requestor
PUSHJ P,MAILOK ;Release mailbox
SKIPN DEBUG
JRST CHGJB2
PUSH P,C ;Print code
PUSH P,[OUTCHR 1]
PUSHJ P,WRSIX↑
OUTSTR[ASCIZ/
/]
CHGJB2: PUSH P,A ;Get user number from PTY number
PUSHJ P,FNDPTY
POPJ P, ;Not one of ours
CAMN C,[SIXBIT/DETJOB/]
JRST [ MOVEI B,[BYTE (9) 600,600,"D","E","T",15,12,0] ;Send ↑C ↑C DET<CR><LF>
PTWRS9 A ;and hope we don't hang!!!
POPJ P, ]
IFN DKPRO,<
CAMN C,[SIXBIT/D.KING/] ;D. King's crockish format??
JRST [ SETOM DKFLAG+NUSERS(U) ;Just turn on flag and hope for the best!!!
SETOM DKIACT(U) ;Mark TELNET channel as being active
ADDI U,NUSERS ;GET INTO GRAPHICS MODE
JRST DKGINI ]
>;IFN DKPRO
POPJ P,
SUBTTL OUTWHR - Write out WHERE table for MAIL, FINGER, etc.
OUTWHR: PUSH P,TAC
MOVE TAC,[XWD 3,[XWD 'NET',0
IOWD WHRLEN,WHRTAB]]
TMPCOR TAC,
JFCL
POP P,TAC
POPJ P,
;-------------------------------------------------
SUBTTL INTSER - Interrupt Service Routine
BEGIN INTSER
;The system sets up the following:
SWBUT ←← 1 ;Spacewar buttons
PROREL ←← 2 ;Protection/Relocation
SWPWRN ←← 3 ;Swap or shuffle warning
PROCNO ←← 4 ;Processor number (1. PDP-10, 2. PDP-6)
OTHSTA ←← 5 ;Status of other processor
JSTAT ←← 6 ;Job status
HIREL ←← 7 ;Size of upper - 1
DATUM ←← 10 ;Interrupt datum
JQUE ←← 14 ;System queue number
↑INTSER:MOVE P,IPDLIOWD ;Get a PDL
AOS INTCNT ;Count the interrupts
IFN DEBPRC,<
aos foodpy
aos foodpy
>;IFN DEBPRC
MOVE TAC,JOBCNI↑
JFFO TAC,INTSE2
IFN DEBPRC,<
SKIPN DEBUG ;Spurious interrupt
DISMIS
MOVE TAC,[ASCID/-RAND/]
MOVEM TAC,NAMLOC
SKIPGE DEBUG
UPGIOT 16,INTDPY
>;IFN DEBPRC
DISMIS
INTSE2: SETOM INTLEV
ROT TAC2,-1 ;Makes table smaller
JUMPGE TAC2,INTSE3 ;Even words
SKIPA TAC,INTTAB(TAC2)
INTSE3: MOVS TAC,INTTAB(TAC2)
IFN DEBPRC,<
SKIPN DEBUG
JRST (TAC)
PUSH P,-1(TAC)
POP P,NAMLOC
SKIPGE DEBUG
UPGIOT 16,INTDPY
>;IFN DEBPRC
JRST (TAC) ;Call routine
INTTAB: XWD BADINT,BADINT ;INTSWW,,INTSWD
XWD BADINT,BADINT ;INTSHW,,INTSHD
XWD BADINT,PTIREQ ;INTTTY,,INTPTI
XWD RDMAIL,BADINT ;INTMAIL,,INTWAIT
IFN CHKSW,<
XWD PTOREQ,PARSER ;INTPTO,INTPAR
>;IFN CHKSW
IFE CHKSW,<
XWD PTOREQ,BADINT ;INTPTO,INTPAR
>;IFE CHKSW
XWD CLKSER,BADINT ;INTCLK,,INTINR
XWD BADINT,IMPSTC ;INTINS,,INTIMS
XWD GTIMPI,ESCI ;INTINP,,INTTTI
XWD BADINT,BADINT ;INTQXF,,bit 17
XWD BADINT,BADINT ;bit 18,,POV
XWD BADINT,BADINT ;bit 20,,bit 21
XWD BADINT,BADINT ;ILM,,NXM
XWD BADINT,BADINT ;bit 24,,bit 25
XWD BADINT,BADINT ;OLDCLK,,bit 27
XWD BADINT,BADINT ;bit 28,,INTFOV
XWD BADINT,BADINT ;bit 30,,bit 31
XWD BADINT,BADINT ;INTOV,,bit 33
XWD BADINT,BADINT ;bit 34,,bit 35
↑INTDIS:IMSKCL 1,JOBCNI
↑INTRET:SKIPN INTLEV
JRST [ MOVE TAC,@OLDPC ;Were we at an interrupt wait
AND TAC,[XWD 777000,777777] ;instruction?
CAME TAC,[IWAIT]
CAMN TAC,[IENBW]
AOS OLDPC ;Yes, increment PC
MOVE TAC,@OLDPC
AND TAC,[XWD 777740,0]
CAMN TAC,[IMSTW]
AOS OLDPC
MOVSI P,OLDACS
BLT P,P
INTJEN OLDMSK ]
SETZM INTLEV
DISMIS
ASCID/NTBAD/
BADINT: MOVE TAC2,JOBCNI ;Oops, what are we doing here!!!
MOVEM TAC2,INTLOS
JRST INTDIS
ASCID/NTTTI/
ESCI: OUTSTR[ASCIZ/<esc>I/]
seto u,
push p,[status]
pushj p,sched
JRST INTRET
; We got some mail, queue up process to read it
; ASCID/NTMAI/
;MAIL: PUSH P,[RDMAIL] ;Queue up process to read mail
; PUSHJ P,SCHED
; JRST INTDIS ;Disable mail interrupt and return
; IMP status changed, let's see how
ASCID/NTIMS/
IMPSTC:
IFN DEBPRC,<
SKIPE DEBUG
OUTCHR["*"]
>;IFN DEBPRC
PUSH P,[IMPCHG]
PUSHJ P,SCHED
JRST INTRET
; Some IMP connection has input for us
ASCID/NTINP/
GTIMPI: MOVSI U,-GRFMUL*NUSERS ;We get to figure out which connection did it
SETOM ALLINP ;Assume all pty input buffer are full unless we
;find out otherwise
jfcl ;Room to patch in PUSHJ P,USERMODE
AOS IMICNT
IMLOOP: SKIPN PTIFUL(U) ;Are we not already trying to stuff things into that PTY
SKIPN PTYNUM(U) ;and is there a PTY for that job?
JRST NOINP ;No, don't look then
REPEAT 0,<
IFE DKPRO,<
MOVE TAC,[MTAPE 000,[10]] ;Is there any input present here?
DPB U,[POINT 4,TAC,12]
>;IFE DKPRO
IFN DKPRO,<
SKIPN DKIACT(U) ;Is channel active?
JRST NOINP ; Not active, skip it
MOVE A,U ;Assume regular channel
SKIPE DKFLAG(U) ;If in DK mode
SUBI A,NUSERS ; check TELNET channel instead
MOVE TAC,[MTAPE 000,[10]] ;Is there any input present here?
DPB A,[POINT 4,TAC,12]
>;IFN DKPRO
MOVEM TAC,LSTIMC# ;*** For debugging ***
XCT TAC ;MTAPE CHAN,[INPSKP]
>;REPEAT 0
; PUSH P,[MTAPE 000,[10]] ;Is there any input present here?
IFE DKPRO,<
DPB U,[POINT 4,FOO,12]
>;IFE DKPRO
IFN DKPRO,<
SKIPN DKIACT(U) ;Is channel active?
JRST NOINP ; Not active, skip it
MOVE A,U ;Assume regular channel
SKIPE DKFLAG(U) ;If in DK mode
SUBI A,NUSERS ; check TELNET channel instead
DPB A,[POINT 4,FOO,12]
>;IFN DKPRO
MOVEM TAC,LSTIMC# ;*** For debugging ***
; XCT (P) ;MTAPE CHAN,[INPSKP]
;The following instruction gets error message 'IO TO UNASSIGNED CHANNEL AT USER XXX'
;under certain unknown circumstances which typically occur when the machine is
;lightly loaded. Self modifying code only because one's AC's vanish when you
;die at user interrupt level!
FOO↑: MTAPE 000,[10] ;Is there any input present?
JRST [ SETZM ALLINP ;No, remember so we can interrupt again
;;; POP P,(P)
JRST NOINP ]
;;; POP P,(P)
SETOM PTIFUL(U) ;Mark as busy
PUSH P,U ;Look for a process waiting for IMP input
HRRZS (P) ;(We just want the user number)
PUSH P,[IMWQUE]
PUSHJ P,SRHQUE
JUMPN RET,[ ;Yes, give him the interrupt
PUSH P,RET ;Give him good service (could be ↑C)
PUSH P,[PRIQUE]
PUSHJ P,ENQUE
AOS RUNWAIT ;Another process waiting for service
JRST NOINP ]
IFN GRFPRO,<
HRRZ A,U
IDIVI A,NUSERS ;No one waiting, create a process to handle it
PUSH P,[IMISER↔GRISER](A);of the appropriate flavour
>;IFN GRFPRO
IFE GRFPRO,<
PUSH P,[IMISER] ;No one waiting, create a process to handle it
>;IFE GRFPRO
PUSHJ P,SCHED
NOINP: AOBJN U,IMLOOP ;Try next user
SKIPN ALLINP ;Are all the buffers full?
JRST INTRET ;No, then just return
JRST INTDIS ;Yes! Don't waste everyone's time checking
;until one become available
; Some PTY is waiting for input
ASCID/NTPTI/
PTIREQ: MOVSI U,-NUSERS ;We get to figure out which PTY(s) did it
jfcl
AOS INPCNT
PILOOP: SKIPN PTBUSY(U) ;Are we waiting to stuff things into that PTY
JRST NXTPTY ;No, don't look then
PUSH P,[PTICHK]
PUSHJ P,SCHED
NXTPTY: AOBJN U,PILOOP ;Try next user
SETZM PTYIWA ;Forget we were waiting
;*** WHERE IS PTYIWA CHECKED? ***
JRST INTDIS
; Some PTY has output for us.
ASCID/NTPTO/
PTOREQ: MOVSI U,-NUSERS ;We get to figure out which one!
POLOOP: SKIPE PTYNUM(U) ;Is there no PTY for this user
SKIPE PTOFUL(U) ;or is there is output going on already?
JRST POCONT ;Yes, no need to make new process
SETOM PTOFUL(U)
PUSH P,[PTOSER]
PUSHJ P,SCHED
POCONT: AOBJN U,POLOOP ;More to go?
JRST INTRET ;No, return
IFN CHKSW,<
ASCID/NTPAR/
PARSER: MOVE 16,[IOWD 3,PARMSG+2]
PUSH 16,[XWD =13,0] ;Compile: Address of error
HRRM DATUM,(16)
PUSH 16,[XWD =14,0] ;Compile: Prot-reloc
PUSH P,PROREL
HRRM P,(16)
PUSH 16,[XWD =14,0] ;Compile: Value
PUSH P,(DATUM)
HRRM P,(16)
PUSHJ P,USERMODE ;Get into user mode, quick!
PUSHJ P,SYSCHK
PUSHJ P,PARMSG
JRST INTRET
>;IFN CHKSW
BEND INTSER
SUBTTL CLKSER - Service clock interrupt
BEGIN CLKSER
;
; *** Warning: This code runs at interrupt level! ***
;
ASCID/NTCLK/
↑CLKSER:AOS CLKCNT ;Number of clock interrupts.
IFN DEBPRC,<
SKIPE DEBUG
OUTCHR ["⊗"]
>;IFN DEBPRC
TIMER A, ;Pick up current time
SUB A,NXTTIM ;Compare with time expected.
ADDM A,CLTDIF ;Remember total amount off for fun.
JUMPL A,[ MOVN A,A
CLKINT 1,(A) ;Next time
AOS CLKBAD ;Increment number of losing interrupts!
JRST CLKEXI ] ;Don't ever run anything early!
ANOTHER:PUSH P,[CLKQUE] ;Get first entry in clock queue
PUSHJ P,DEQUE
JUMPE RET,[PUSHJ P,DRYROT ;Clock interrupt with no process to run!
JRST QUIET]
PUSH P,RET ;Queue it to be run
PUSH P,[PRIQUE] ;Priority service for clock interrupts.
PUSHJ P,ENQUE
IFN DEBPRC,<
SKIPE DEBUG
OUTCHR ["+"]
>;IFN DEBPRC
AOS RUNWAIT ;Increment number of processes waiting to be run
SKIPN TAC,CLKQUE ;Get pointer to next process
JRST QUIET ;Last process
HLRZ TAC2,%DATUM(TAC) ;Get incremnt to clock
ADDM TAC2,NXTTIM
SUB TAC2,A
JUMPLE TAC2,ANOTHER ;It happened already!!!
CLKINT 1,(TAC2) ;When to return
JRST CLKEXI
QUIET: CLKINT 1,0 ;Turn off clock interrupts
SETZM NXTTIM
CLKEXI:
IFN DEBPRC,<
SKIPE DEBUG
OUTCHR ["≥"]
>;IFN DEBPRC
JRST INTRET ;And return
BEND CLKSER
SUBTTL IMPCHG - IMP status change
BEGIN IMPCHG
;
; Check status of IMP connection, invoking processes to take care of
; them. This routine is primarily designed to run at interrupt level.
;
; Assume it destroys all acs except P
;
↑IMPCHG:MOVSI U,-GRFMUL*NUSERS-NSPECU ;User number
MOVEI A,IMPST1 ;Index for saving IMP status
MOVE B,[GETSTS 000,E]
MOVSI C,400000 ;Bit mask for IMP I/O present
MOVEI D,2 ;Opcode for GET STATUS
ISLOOP: TDNN C,IMPMAP ;Is there an IMP here?
JRST NOTIMP
XCT B ;Get status of I/O
EXCH E,2(A)
; MOVEM E,OLDST1-IMPST1+1(A) ;See what bits came on
ANDCA E,2(A)
TLNE E,HDEAD!CTROV!RSET!TMO ;Anything indicating great lossage
JRST [ PUSH P,A
TLNE E,TMO
MOVEI A,[ASCIZ/Timeout. Connection closed. /]
TLNE E,CTROV
MOVEI A,[ASCIZ/Host overflow allocation. Connection closed. /]
TLNE E,HDEAD
MOVEI A,[ASCIZ/Host dead. /]
TLNE E,RSET
MOVEI A,[ASCIZ/Host sent reset. Connection closed. /]
PUSH P,[KLUSER]
PUSHJ P,SCHED
JRST NOTIMP ]
ADD B,[<MTAPE 000,D>-<GETSTS 000,E>]
XCT B ;Get status of rcv and xmit connections
ADD B,[<GETSTS 000,E>-<MTAPE 000,D>]
EXCH E,(A) ;Save new status and get old
EXCH F,1(A)
; MOVEM E,OLDST1-IMPST1(A)
; MOVEM F,OLDST1-IMPST1+1(A)
ANDCA E,(A) ;Note bits were turned on
ANDCA F,1(A)
TLNN F,CLSR ;Close recieved?
TLNE E,CLSR
JRST CLOSIT ;Yes, reply with close
ORM E,CHGFLG(U) ;Mark bits which changed
MOVSS F
ORM F,CHGFLG(U)
MOVSS F
PUSH P,U ;Look for a process waiting for IMP status change
HRRZS (P) ;(We just want the user number)
PUSH P,[IMSQUE]
PUSHJ P,SRHQUE
JUMPN RET,[ ;Yes, give process the interrupt
PUSH P,RET ;Give it good service
PUSH P,[PRIQUE]
PUSHJ P,ENQUE
AOS RUNWAIT ;Another process waiting for service
JRST NOTIMP ]
NOTIMP: ADDI A,3 ;Increment status pointer
ADD B,[1B12] ;Increment channel in MTAPE
ROT C,-1 ;Move test bit
AOBJN U,ISLOOP ;More to come
POPJ P,
CLOSIT: PUSH P,A ;Save some acs
PUSH P,U
HRRZ U,U ;Flush count from left half
CAIN U,U.ICP ;Is it ICP listen being closed?
SKIPA A,[CLOICP] ; Yes, start new listen
MOVEI A,KLUSER ;No, flushing user connection
PUSH P,A ;Process to handle close
MOVEI A,[ASCIZ/Connection closed. /] ;Message for KLUSER
PUSHJ P,SCHED
POP P,U
POP P,A
JRST NOTIMP
BEND IMPCHG
SUBTTL PTYSER - Service PTY
BEGIN PTYSER
ASCID/NPTO/
↑PTOSER:MOVE A,PTYNUM(U) ;Get PTY number
IFN DEBPRC,<
SKIPE DEBUG
outchr ["←"]
>;IFN DEBPRC
IFN SPYSW,<
PUSHJ P,SPY
>
POLOOP:
ENTERLOCK PTOLOK ;Enter interlock for PTY's
PTOCNT A ;Make sure we don't hang waiting
JUMPE B,NOREAD ;Oops, nothing left
LEAVELOCK PTOLOK ;Leave interlock for PTY
SKIPN B,PTOBUF(U)
PUSHJ P,DRYROT
PTRDS A ;Read a string from PTY
IFN IMLSW,<
SKIPE IMLACT(U) ;Imlac mode?
JRST IMLHAK ; Yes, hack it before sending it!
>;IFN IMLSW
PUSH P,B
PUSHJ P,IMPSTR ;Output string to IMP
POCONT: PUSH P,[RUNQUE]
PUSHJ P,RESCHED ;Give others a chance
JRST POLOOP
NOREAD: SETZM PTOFUL(U) ;We're no longer looking for output, tell
LEAVELOCK PTOLOK ;Leave interlock for PTY
TURNON [INTPTO] ;Enable INTPTO
IFN DEBPRC,<
SKIPE DEBUG
outchr ["→"]
>;IFN DEBPRC
CPOPJ: POPJ P,
↑IMISER:MOVEI A,3 ;Pointer into INHDR
IMULM U,A
MOVE B,PTYNUM(U) ;Get PTY number
IFN DEBPRC,<
SKIPE DEBUG
outchr[173] ;open curly bracket!!!!
>;IFN DEBPRC
CILOOP: PUSHJ P,IMICHS ;Check for character from IMP ready
IFE DEBPRC,<
JRST [ SETZM PTIFUL(U) ;None, clear flag saying being serviced
TURNON [INTINP]
POPJ P, ]
>;IFE DEBPRC
IFN DEBPRC,<
JRST [ SETZM PTIFUL(U) ;None, clear flag saying being serviced
TURNON [INTINP]
skipe debug
outchr[176] ;close curly bracket!!!!
POPJ P, ]
>;IFN DEBPRC
CAIL RET,200 ;Protocol perhaps?
JRST SPCHAR ;Handle it
NOTSP: PUSHJ P,STUFF ;Try to stuff it at the PTY
JRST CILOOP ;Success, try another
PUSH P,[=15] ;Wait a little and try again
PUSHJ P,POSTPONE
PUSHJ P,STUFF ;Try to send it again
JRST CILOOP ;Success, try another
PUSH P,[=60] ;Lose again, try one more time!
PUSHJ P,POSTPONE
IRETRY: PUSHJ P,STUFF ;Try to send it again
JRST CILOOP ;Finally! Now, try another
MOVEM TAC,PTBUSY(U) ;This is a hard core case, wait until we get
;interrupt saying the PTY thinks it's ready
SETOM PTYIWA ;Remember that someone is waiting for PTY
;input. USECHK looks at this flag.
TURNON [INTPTI]
POPJ P,
↑PTICHK:MOVEI A,3 ;Pointer into INHDR
IMULM U,A
MOVE B,PTYNUM(U) ;Get PTY number
MOVE C,PTBUSY ;Get character we were trying to stuff
JRST IRETRY
STUFF: MOVE C,RET
PTWR1S B
; AOS (P)
; POPJ P,
jrst [ aos(p)
popj p,]
; skipe debug
; outchr c
popj p,
SPCHAR:
IFN NEWPRO,< CAIN RET,$IAC ;New protocol commands
JRST DOIAC >
ANDI RET,177 ;Otherwise, map onto ASCII (sigh...)
JRST NOTSP
SUBTTL IMLHAK - Hack Imlac compatability mode
IFN IMLSW,<
BEGIN IMLHAK
COMMENT ⊗
NETGRF pretends it's an Imlac in Extended-ASCII mode so that all
characters can be handled (since β is ↑C, etc.)
[The following was extracted from IMLHAK.BO[UP,DOC] on 3-Sep-75]
SUMMARY OF COMMANDS TO THE IMLAC (all prefixed with a rubout)
OCTAL NO. OF
CHAR CODE OPERANDS FUNCTION
λ 010 0 __ Print a center dot (the hidden code for null)
TAB 011 0 \
LF 012 0 |
VT 013 0 | Print that char the way DD does it when
FF 014 0 | prefixed with a rubout.
CR 015 0 __/
∞ 016 0 No-op
∂ 017 0 Print a BS char as on the DD.
1-7 060+n n Enter re-edit mode, clear the edit buffer if
mode wasn't re-edit, and add the following n
characters to the edit line as if the user
had typed them. Re-edit mode locks out the
IMLAC keyboard except the CALL, ESC, BREAK,
and CLEAR keys.
0 060 0 Enter line mode. Used to terminate re-edit
mode and leave the cursor at the right end
of the line.
∧ 004 0 Move the cursor to the left end of the line.
This command does not terminate re-edit
mode.
¬ 005 0 Same as 004, but terminates re-edit mode.
ε 006 1 Move the cursor right the number of positions
specified by the octal code of the following
character, then terminate re-edit mode.
π 007 0 Clear edit line, terminate re-edit.
↓ 001 0 INCHRW. If the edit buffer is not empty and
the cursor is not at the left end, send the
first char from the buffer. Otherwise, set
the break table to activate on the next char
typed.
α 002 0 DDT mode INCHWL. If the edit buffer
contains a word-mode break char to the left
of the cursor, then send the first part of
the buffer up to and including the first
such char. Otherwise, set the break table
to activate on the next such char typed.
β 003 0 Enter character mode.
The IMLAC reverts to line mode after complying with the 001 and 002
commands. (These commands are no-ops in Character mode.)
⊗;
↑IMLHAK:PUSH P,A ;Save for safety
HRLI B,(<POINT 7,0>) ;Make into byte pointer
IMLHA2: MOVE A,B ;Copy byte pointer
IMLHA3: ILDB RET,B ;Get character
IMLHA4: JUMPE RET,[PUSH P,A
PUSHJ P,IMPSTR
JRST IMLDON]
CAIE RET,177
JRST IMLHA3
SETZ RET, ;Replace 177 with null to terminate string
DPB RET,B
PUSH P,B ;Send string upto where 177 was seen
PUSHJ P,IMPSTR
ILDB RET,B ;Pick up command character
CAILE RET,IMLLEN ;Jump table opcode?
JRST IMLHA5 ;Maybe line edit
PUSHJ P,@IMLTAB(RET) ;Execute operation
JRST IMLHA2 ;Back for more
IMLHA5: CAIL RET,060 ;Re-edit?
CAILE RET,067
JRST [ PUSHJ P,IMLBAD ;No, give up and complain
JRST IMLHA2 ] ;Then try again
;For now, will ignore re-edit commands and just pass on text
MOVE B,A ;Copy byte pointer
JRST IMLHA4 ;And just send as normal text for now
IMLDON: POP P,A
JRST POCONT
IMLTAB: IMLBAD ;000 Can't happen this way!!!
CPOPJ ;001 ↓ INCHRW [no-op]
CPOPJ ;002 α DDT mode INCHWL [no-op]
CPOPJ ;003 β Enter character mode [no-op]
CPOPJ ;004 ∧ Do local <control><form> [no-op]
CPOPJ ;005 ¬ Same as 004, but terminates re-edit setup. [no-op]
[IBP B ;006 ε Move cursor right by arg. positions and
CPOPJ: POPJ P,] ; terminate re-edit setup. [no-op]
;007 π Clear edit line, terminate re-edit setup. [no-op]
[MOVEI RET,0 ;010 λ Print a center dot (hidden null)
JRST IMPOCHR]
IMPOCHR ;011 TB Print TB like DD [just send character for now]
IMPOCHR ;012 LF Print LF like DD [just send character for now]
IMPOCHR ;013 VT Print integral sign [just send character for now]
IMPOCHR ;014 VT Print plus-minus sign [just send character for now]
IMPOCHR ;015 CR Print CR like DD [just send character for now]
CPOPJ ;016 ∞ No-op
[MOVEI RET,177 ;017 ∂ Print BS like DD [send one]
PUSHJ P,IMPOCHR]
IMLLEN←←.-IMLTAB
;Bad Imlac command
IMLBAD: MOVE C,RET ;Copy somewhere safe
PUSHJ P,LOGIT
XWD 7,[ASCIZ/Bad Imlac command: /]
XWD =8,C
0
POPJ P,
BEND IMLHAK
>;IFN IMLSW
SUBTTL NEWPRO - Interpet new TELNET protocol
IFN NEWPRO,<
DOIAC: PUSHJ P,IMICHW ;Next byte is command
CAIL RET,NPLOW ;Within range?
JRST @NPTAB-NPLOW(RET) ;No! return
JRST CILOOP
NPLOW←←$SE
NPTAB: CILOOP ;SE End of subnegotiation
CILOOP ;NOP
CILOOP ;DATAM Datam mark
STOPJOB ;BREAK Break (↑C)
STOPJOB ;IP Interrupt process
CLROUT ;AO Abort output
SNDWHO ;AYT Are you there? (Sends who line)
;The following two are done wrong in Imlac mode (IMLSW ∧ IMLACT(U)
[MOVEI RET,177 ;EC Erase character
JRST NOTSP]
[MOVEI RET,"U"-100 ;EL Erase line
JRST NOTSP]
CILOOP ;GA Go ahead
SUBNEG ;SB Subnegotiation begin
NEGOTIATE ;WILL Desire to begin performing or confirmation
;373 of an option
NEGOTIATE ;WONT Refusal to begin performing or continue
;374 an option
NEGOTIATE ;DO Request for other party to performing or
;375 confirmation of that you are expecting
; the performation of an option
NEGOTIATE ;DONT Request for other party to performing or
;376 confirmation of that you are expecting
; the performation of an option
NOTSP ;IAC Quote an IAC
STOPJOB:
MOVEI C,7 ;Clear PTY's input buffer
PTJOBX B
MOVEI C,600 ;Send a <CALL> (send two 600's)
PTWR1W B
STOP2: MOVEI RET,600
JRST NOTSP
CLROUT:;SETO C, ;No interrupts while we flush stuff in
; IMSKCR C ;output buffer
ENTERLOCK IMOLOK ;Interlock again IMP output
HRRZ TAC,OUTHDR(A) ;Make a new byte pointer
HLL TAC,OUTHDR+1(A)
TLZ TAC,770000 ;Reset to last byte in word previous to data
MOVEM TAC,OUTHDR+2(A)
LSH TAC,-=24 ;Pick up byte size
MOVEI TAC2,=36 ;Number of bytes per word
IDIVM TAC2,TAC
HLRZ TAC2,OUTHDR(A) ;Number of words
TLZ TAC2,400000
SUBI TAC2,1
IMUL TAC,TAC2 ;Total number of bytes
MOVEM TAC,OUTHDR+2(A)
; INTMSK (C) ;Restore interrupts
LEAVELOCK IMOLOK ;Interlock again IMP output
MOVEI RET,10000+"O" ;Send PTY a <ESC>O
JRST NOTSP
; Are You There (respond with WHO line)
SNDWHO:; MOVBI TAC,WHOBIT
movsi tac,whobit ;*** Fix that macro ***
TDNE TAC,FLAGS(U) ;In a WHO line already?
JRST CILOOP ;Yes, ignore
ORM TAC,FLAGS(U) ;No, enter one then (timing race not important
;here, so what if he requests too many WHOs)
PUSHJ P,MKPBLK
MOVE C,RET ;Save address of block
MOVE D,RET
SUBI D,PROCSZ-2 ;Point to second word
HRRZ TAC,B ;Get number of controling job
TTYJOB TAC,
SKIPG TAC ;Get system WHO line if no job
SETO TAC,
HRL D,TAC
WHO D, ;Get WHO line
HRRZ D,D
PUSH P,[WHOOUT] ;Make process to output who
PUSHJ P,SCHED
PUSH P,[RUNQUE]
PUSHJ P,RESCHED
JRST CILOOP
WHOOUT: PUSH P,D
PUSHJ P,IMPSTR ;Send WHO line
PUSH P,C
PUSHJ P,KLPBLK
MOVSI TAC,WHOBIT
ANDCAM TAC,FLAGS(U)
POPJ P,
SUBNEG: PUSHJ P,IMICHW ;Get option number
IFN IMLSW,<
CAIN RET,$EXTASC ;Extended ASCII?
JRST DOEXTA ; Yes, go off to deal with it
>;IFN IMLSW
;Unknown option subnegotiation, look for IAC SE
IGNSUB: PUSHJ P,IMICHW ;Get a character
CAIE RET,$IAC ;Command?
JRST IGNSUB ;No, try again
PUSHJ P,IMICHW ;Which one?
CAIN RET,$SE ;End of Subnegotiation?
JRST CILOOP ;Yes, done
CAIL RET,$SB ;No, ignore command. Another byte to get?
CAILE RET,$DONT
JRST IGNSUB ;No, back to looking for IAC
PUSHJ P,IMICHW
JRST IGNSUB
;Other party wants something changed.
NEGOTIATE:
MOVE C,RET ;Save command
SKIPE DEBUG
OUTSTR@[[ASCIZ/WILL /]
[ASCIZ/WON'T /]
[ASCIZ/DO /]
[ASCIZ/DON'T /] ]-$WILL(C)
PUSHJ P,IMICHW
MOVE D,RET ;Save option number
SKIPN DEBUG
JRST NEGOT2
PUSH P,D
PUSHJ P,TYPDEC
NEGOT2: CAIN D,$ECHO ;Echo option?
JRST @ECHOS-$WILL(C)
IFN IMLSW,<
CAIN D,$EXTASC ;Extended ASCII?
JRST @EXTAST-$WILL(C)
>;IFN IMLSW
CAIN D,$SGA ;Agree with whatever they say, and then lie
JRST ACKPOS ;through our teeth and never send GA!!!
;We don't recognize that option, send negative acknowledgement of option
ACKNEG: TRNE C,1 ;Make WILL or DO into WONT or DONT
ADDI C,1
TRC C,2 ;Change WONT ↔ DONT
SNDACK: MOVSI TAC,400000 ;See if this is a confirmation?
MOVN RET,D
LSH TAC,(RET)
TDNE TAC,PROMAP(U)
JRST [ ANDCAM TAC,PROMAP(U) ;Yes, don't send them another!
JRST CILOOP ]
MOVEI RET,$IAC ;Begin command
PUSHJ P,IMPOCH
MOVE RET,C ;Command
PUSHJ P,IMPOCH
MOVE RET,D ;Option
PUSHJ P,IMPOCH
PUSHJ P,IMPOUT
SKIPN DEBUG
JRST CILOOP
OUTSTR [ASCIZ/ [I /]
OUTSTR@[[ASCIZ/WILL /]
[ASCIZ/WON'T /]
[ASCIZ/DO /]
[ASCIZ/DON'T /] ]-$WILL(C)
PUSH P,D
PUSHJ P,TYPDEC
OUTCHR ["]"]
JRST CILOOP
ECHOS: ACKNEG ;He wants to echo our output. Tell him not to
ACKNEG ;He's OK
[ PUSHJ P,SETECHO ;He wants us to echo, that's OK
MOVEI C,$WILL
JRST SNDACK ]
[ PUSHJ P,CLRECHO ;He wants us to stop echoing, that's OK
MOVEI C,$WONT
JRST SNDACK ]
IFN IMLSW,<
;Option table for Extended ASCII (using Imlac mode)
EXTAST: [ SETOM IMLACT(U) ;He wants to send Extended ASCII, set Imlac mode
;Note: This means we have to handle line edit!
PTGETL B ;Turn on Imlac mode
TLO TAC2,IMLBIT
PTSETL B
MOVEI C,$DO ;Acknowledge it
JRST SNDACK ]
[ PTGETL B ;Turn off Imlac mode
TLZ TAC2,IMLBIT
PTSETL B
SETZM IMLACT(U) ;He wants to stop Extended ASCII, clear Imlac mode
MOVEI C,$DONT ;Acknowledge it
JRST SNDACK ]
ACKNEG ;We don't send Extended-ASCII
ACKNEG ;Never did
;Recieve Extended ASCII
DOEXTA: PUSHJ P,IMICHW ;Get high order bits
ASH RET,=8 ;Put it into position
MOVE C,RET ;Save somewhere safe
PUSHJ P,IMICHW ;Get low order bits
ADD C,RET ;Form 9 bit word
TRNN C,600 ;Any bucky bits?
JRST NOTSP ;Yes, this one is easy
TRNN C,177 ;CALL?
JRST [ CAIE RET,600 ;Yes, handle it specially
JRST STOP2
JRST STOPJOB ]
PUSH P,[BYTE (9) 240,0,0,0,0] ;Two bytes to send one IMLAC character
DPB C,[POINT 9,(P),15] ;Set low order two bits in high order byte
TRZ C,600
DPB C,[POINT 9,(P),17] ;Set seven bits in second byte
DOEXT2: PTIFRE B ;See whether there is space
CAIL C,2 ;Enough space?
JRST [ MOVEI C,(P) ;Yes, send it!
PTWRS9 B
POP P,(P) ;Flush stack
JRST IGNSUB ] ;and rest of negotiation
PUSH P,[=15] ;Wait a little
PUSHJ P,POSTPONE
JRST DOEXT2 ;and try again
>;IFN IMLSW
ACKPOS: ADDI C,1 ;Give positive response to request
TRC C,2
SOJA C,SNDACK
>;IFN NEWPRO
; Turn on echoing
SETECHO:PTGETL B
TLZ C,FULTWX
PTSETL B
POPJ P,
; Turn off echoing
CLRECHO:PTGETL B
TLO C,FULTWX
PTSETL B
POPJ P,
BEND PTYSER
SUBTTL NETOPN - Open duplex network connection
BEGIN NETOPN
;
; PUSH P,<local socket #>
; PUSH P,<host number (or zero for listen)>
; PUSH P,<foreign socket number (or zero for listen)>
; PUSH P,<byte size>
; PUSHJ P,NETOPN
;
; Assume destroys all but U
;
↑NETOPN:HRRZI A,1(P) ;Allocate space for MTAPE block
ADD P,[XWD 7,7]
JUMPGE P,[PUSHJ P,DRYROT ;LOSE!!
MOVEI A,[ASCIZ/No space for MTAPE block!
/]↔ NETKIL: PUSHJ P,KLUSER
JRST PREXIT ] ;Gee, this shouldn' be necessary
MOVEI TAC,1 ;Assume LISTEN then reset to CONNECT
MOVEM TAC,(A) ;if foreign socket is defined
MOVE TAC,-4-7(P) ;Set local socket
MOVEM TAC,2(A)
MOVE TAC,-3-7(P) ;Set foreign host number
MOVEM TAC,6(A)
SKIPN TAC,-2-7(P) ;Set foreign socket number
JRST [ SKIPN -3-7(P) ;None, do consistency check
JRST NETOP3
PUSHJ P,DRYROT ; Oops!!!!
MOVEI A,[ASCIZ/Bad call to NETOPN
/]↔ JRST NETKIL ] ;Continue regular line
SKIPN -3-7(P) ;Consistency check
PUSHJ P,DRYROT ; Failed!
SETZM (A) ;No, want a CONNECT
NETOP3: MOVEM TAC,5(A)
MOVE TAC,-1-7(P) ;Set byte size
MOVEM TAC,4(A)
SETZM 3(A) ;Don't wait!!!
MOVE B,[MTAPE 000,(A)] ;Now, start connect, but don't wait
DPB U,[POINT 4,B,12]
XCT B ;MTAPE 000,[CONNECT...]
MOVEI TAC,77
AND TAC,1(A) ;Pickup error code
JUMPN TAC,[ ; Connection error
CONERR: CAILE TAC,MAXCER ;Bless the error code returned by CONNECT
SKIPA A,[[ASCIZ/Connect error code out of range!
/]]↔ MOVE A,CONERM(TAC) ;Get error message
SUB P,[XWD 7,7]
JRST NETKIL ] ;Flush MTAPE block
CAIN U,U.ICP ;Is it the server ICP?
JRST CONCHK ; Yes, just check connection now.
MOVE RET,-1-7(P) ;Set byte size again to be safe
MOVEM RET,4(A)
AOS 2(A) ;Increment local socket
SKIPE 5(A) ;Watch for listen
SOS 5(A) ;Decrement foreign ssocket
XCT B ;MTAPE 000,[CONNECT...]
MOVEI TAC,77
AND TAC,1(A) ;Pickup error code
JUMPN TAC,CONERR ; Error found, abort process
CONCHK: MOVEI RET,2 ;Get status of connecton
MOVEM RET,(A)
XCT B ;MTAPE 000,[GET STATUS]
SETZM CHGFLG(U) ;Reset record of changes
CAIN U,U.ICP ;Only want transmit for ICP
JRST SKPRCV
MOVE TAC,2(A) ;See if recieve side is open
TLNN TAC,RFCR
JRST CONWAI ;No, wait for it
SKPRCV: MOVE TAC,1(A) ;See if transmit side is open
TLNN TAC,RFCR
JRST CONWAI ;No, wait for it too
SUB P,[XWD 7+5,7+5] ;Flush stack
JRST @5(P) ;Done, return
;Wait for something to happen
CONWAI: TURNOFF [INTIMS] ;Watch timing race
SKIPE CHGFLG(U) ;Did something change?
JRST [ TURNON [INTIMS] ;Enable and try again
JRST CONCHK ]
;**** Crock: TURNON [INTIMS] in WSCHED !!!! ****
PUSHJ P,GETPRO ;Set code to wait on
HRLM U,%DATUM(TAC)
PUSH P,[IMSQUE] ;IMP Status wait
PUSHJ P,WSCHED ;Wait for connection
JRST CONCHK
BEND NETOPN
↑CONERM:[ASCIZ/No error, how did we get here.
/]↔ [ASCIZ/Socket in use.
/]↔ [ASCIZ/Can't change socket numbers.
/]↔ [ASCIZ/Horrible system error - CONNECT.
/]↔ [ASCIZ/No link available. IMP capacity exceeded.
/]↔ [ASCIZ/Illegal byte size.
/]↔ [ASCIZ/IMP dead.
/]↔ [ASCIZ/Gender mismatch
/]
MAXCER←←.-CONERM-1
SUBTTL SPY - Find out who is using NETGRF
BEGIN SPY
↑SPY: SKIPE TAC,WHOTAB(U) ;Do we know yet?
MOVE TAC,['100100'] ;Check 100,100 everytime
CAME TAC,WHOTAB(U)
POPJ P,
SKIPN TAC,PTYNUM(U) ;Get corresponding PTY, if any
POPJ P,
HRRZ TAC,TAC
TTYJOB TAC, ;Get job number if any
JUMPE TAC,CPOPJ
MOVEI TAC2,211 ;Access system's PRJPRG table
PEEK TAC2,
ADD TAC2,TAC
PEEK TAC2,
JUMPE TAC2,CPOPJ ;If zero, remember most recent
CAMN TAC2,[' 1 2'] ;If it's accounting, forget it!
POPJ P,
PUSH P,WHOTAB(U) ;Save old entry for later testing
MOVEM TAC2,WHOTAB(U) ;Set entry in WHOTAB
SETZM SPYBUF
CAME TAC2,['100100']
JRST NOT100
HRRM TAC,SPYTMC
MOVE TAC2,[XWD 1,SPYTMC]
TMPCRD TAC2,
JRST NOT100
MOVE TAC2,SPYBUF
EXCH TAC2,SPYTAB(U)
CAME TAC2,SPYTAB(U)
JRST GOTNET
NOT100: MOVE TAC2,WHOTAB(U)
CAMN TAC2,(P)
JRST SPYDON
GOTNET: PUSHJ P,OUTWHR
MOVE TAC2,WHOTAB(U)
PUSHJ P,LOGIT
XWD 7,[ASCIZ/User #/]
XWD =10,U
XWD 7,[ASCIZ/ is job /]
XWD =10,TAC
XWD 7,[ASCIZ/ /]
XWD 6,TAC2
XWD 7,[ASCIZ/ /]
XWD 7,SPYBUF
0
SPYDON: POP P,(P)
CPOPJ: POPJ P,
BEND SPY
SUBTTL GRISER - Graphic Input Service
IFN GRFPRO,<
BEGIN GRISER
;
; Handle input from the network graphics connection
↑GRISER:MOVEI A,3 ;Pointer into INHDR
IMULM U,A
PUSHJ P,IMICHS ;Get command
JRST [ SETZM PTIFUL(U) ;Nothing to do, quit
TURNON [INTINP]
POPJ P,]
CAIN RET,$INQRS ;Better be an inquiry response
JRST INQRS
PUSH P,[[ASCIZ/Unknown graphics input.
//]]↔
PUSHJ P,GRFERM
skipe debug
outchr ret
JRST GRISER
SUBTTL RDINQRS- Read Inquiry Response
;
INQRS: PUSHJ P,RCVCNT ;Receive the count
MOVE D,RET ;Save count
IQLOOP: SOJL D,INQDON
PUSHJ P,IMICHW ;Get an option
MOVE C,RET ;Save it
PUSHJ P,RCVCNT ;Get the count
MOVE B,RET
CAIG C,MAXOP ;Bigger than we know about?
JRST @OPTTAB(C) ;No, service it then
IGNOPT: SOJL B,IQLOOP ;Ignore this option
PUSHJ P,IMICHW
JRST IGNOPT
OPTTAB: IGNOPT ;Unknown, oh, well, ignore it for now
IIMPL ;$IIMPL - Implemented commands
ISCREEN ;$ISCRE - Screen coordinate system
MAXOP←←.-OPTTAB
;Implemented commands
IIMPL: MOVEI C,=8 ;Point to table of implemented commands
IMULM U,C
ADDI C,IMPLTB-8*NUSERS
HRLI C,(<POINT 8,0>)
SETZM (C) ;Zero the table
MOVEI RET,1(C)
HRL RET,C
BLT RET,7(C)
JUMPE B,[PUSH P,[[ASCIZ/No implemented commands recieved??
/]]↔ PUSHJ P,GRFERM
JRST IQLOOP]
IILOOP: PUSHJ P,IMICHW ;Start filling the table
IDPB RET,C
SOJG B,IILOOP
JRST IQLOOP
;Screen coordinate system
ISCREEN:PUSHJ P,RCV32
MOVEM RET,XMIN-NUSERS(U) ;X minimum
PUSHJ P,RCV32
MOVEM RET,YMIN-NUSERS(U) ;Y minimum
PUSHJ P,RCV32
SUB RET,XMIN-NUSERS(U) ;X multiplier
ASH RET,-1 ;X constant used in SNDCOORD
MOVEM RET,XMUL-NUSERS(U)
ADD RET,XMIN-NUSERS(U)
MOVEM RET,XK-NUSERS(U)
PUSHJ P,RCV32
SUB RET,YMIN-NUSERS(U) ;Y multiplier
ASH RET,-1 ;Y constant used in SNDCOORD
MOVEM RET,YMUL-NUSERS(U)
ADD RET,YMIN-NUSERS(U)
MOVEM RET,YK-NUSERS(U)
PUSHJ P,RCVCNT
MOVEM RET,BYTES-NUSERS(U)
CAILE RET,4
JRST [ PUSH P,[[ASCIZ/Max. bytes for co-ordinates is 4/]]
PUSHJ P,GRFERM
JRST IQLOOP ]
MOVNI B,8
IMULM RET,B
HRRZM B,ROTS-NUSERS(U)
JRST IQLOOP
;Inquiry done, remember this and send greeting
INQDON: MOVBI RET,INQBIT
ORM RET,FLAGS-NUSERS(U)
MOVBI RET,GREBIT
ENTERLOCK DPYLOK
TDZ RET,FLAGS-NUSERS(U)
ORM RET,FLAGS-NUSERS(U)
LEAVELOCK DPYLOK
JUMPE RET,GRISER
PUSH P,[SNDGREET]
PUSHJ P,SCHED
JRST GRISER
BEND GRISER
>;IFN GRFPRO
SUBTTL RCVCNT - Recieve Graphics Count
IFN GRFPRO,<
BEGIN RCVCNT
↑RCVCNT:PUSHJ P,IMICHW ;Get first byte
CAIGE RET,200 ;Small number?
POPJ P, ;Yes, return
SUBI RET,200 ;This is the high order part
LSH RET,8
PUSH P,RET
PUSHJ P,IMICHW ;Get low order part
ADD RET,(P) ;Now we have the whole thing
SUB P,[XWD 2,2]
JRST @1(P)
BEND RCVCNT
>;IFN GRFPRO
SUBTTL RCV32 - Receive 32 bits
IFN GRFPRO,<
BEGIN RCV32
;
; Called with:
; MOVEI U,<user number>
; MOVEI A,<3*user number>
; PUSHJ P,RCV32
; Returns 32 bit number in RET
; Preserves all other ACs
;
↑RCV32: PUSH P,B
PUSHJ P,IMICHW
MOVE B,RET
TRNE B,200
ORI B,777400
LSH B,8
PUSHJ P,IMICHW
ADD B,RET
LSH B,8
PUSHJ P,IMICHW
ADD B,RET
LSH B,8
PUSHJ P,IMICHW
ADD RET,B
POP P,B
POPJ P,
BEND RCV32
>;IFN GRFPRO
SUBTTL GRFERM - Graphics error message
IFN GRFPRO,<
BEGIN GRFERM
↑GRFERM:SKIPE DEBUG ;Send an error message
OUTSTR @-1(P)
SUBI U,NUSERS
PUSH P,-1(P)
PUSHJ P,IMPSTR
ADDI U,NUSERS
SUB P,[XWD 2,2]
JRST @2(P)
BEND GRFERM
>;IFN GRFPRO
SUBTTL IIISIM - Simulate III Display
IFN GRFPRO,<
BEGIN IIISIM
;
; Called with:
; PUSH P,[<job number>]
; PUSH P,[<display header>]
; PUSH P,[<POG number>]
; PUSHJ P,IIISIM
;
; It is assumed that all ACs are destroyed except 0, U and P.
;
IIIX←D+1 ;III X Register
IIIY←IIIX+1 ;III Y Register
IIIPC←IIIY+1 ;III Program Counter
IIIBEG←IIIPC+1 ;Beginning of display program
IIIEND←IIIBEG+1 ;End of display program + 1
;The following three must be in order
IIIMIN←IIIEND+1 ;Minimum address in core
IIIMAX←IIIMIN+1 ;Maximum address in core
RELOC←IIIMAX+1 ;Address of III program buffer - IIIMIN
IFGE RELOC-U,<PRINTX Too many AC's in IIISIM>
;
WRAPBIT←←20
EDGEBIT←←40
;
↑IIISIM:;ADDI U,NUSERS ;We're outputting on graphics link! *** Should already have set U
MOVEI A,3 ;Pointer to output buffer
IMULM U,A
SETO TAC, ;Display channel already in use?
EXCH TAC,DPYUSE-NUSERS(U)
JUMPE TAC,IIISI2 ;No, continue then
PUSH P,[GRFQUE] ;Else wait for it
PUSHJ P,WSCHED
IIISI2: MOVEI RET,$SGOPN ;Open segment:
PUSHJ P,IMPOCHR ;$SGOPN <segment number>
MOVE RET,-1(P)
PUSHJ P,SNDNAM
MOVE B,-3(P) ;Read the display header
MOVE C,-2(P)
CAME B,THISJOB ;Is it us?
SKIPN B ;or zero
JRST [ MOVE IIIBEG,(C) ;No moniter call necessary!
MOVE IIIEND,1(C)
SETZ RELOC,
MOVE IIIMIN,IIIBEG
MOVE IIIMAX,IIIEND
JRST GOTHDR ]
HRLI C,-2 ;Setup for JOBRD, number of words to transfer
MOVEI D,IIIBEG
PUSHJ P,GET1K ;Get a block to put display code into
MOVE RELOC,RET
SETZB IIIMIN,IIIMAX ;Nothing in core yet
MOVEI RET,B
JOBRD RET,
JRST [JRDERR: MOVEI RET,[ASCIZ/Can't read display buffer of user job/]
JRST IIIERR ]
GOTHDR: ADD IIIEND,IIIBEG
ADD IIIMAX,IIIMIN
MOVEI IIIPC,1(IIIBEG)
HRLI IIIBEG,RELOC ;Put in index field for RELCHK
HRLI IIIEND,RELOC
HRLI IIIMIN,RELOC
HRLI IIIMAX,RELOC
HRLI IIIPC,RELOC
RELOOP: MOVEI RET,=100 ;Interval between rescheduling
MOVEM RET,-2(P)
IILOOP: SOSG -2(P) ;Time to reschedule?
JRST [ PUSH P,[RUNQUE] ;Yes, let others run!
PUSHJ P,RESCHED
JRST RELOOP ]
PUSHJ P,RELCHK ;Check relocation
MOVE RET,@IIIPC ;Get instruction
TRZE RET,1 ;Text?
JRST DOTEXT ;Yes, quick dispatch
MOVE B,RET ;Get opcode
ANDI B,17 ;Low order 4 bytes
LSH B,-1 ;We already know Bit 35 = 0
JOV @IIIOPS(B) ;Turn off overflow bit
JRST @IIIOPS(B) ;[Overflow not on]
IIIOPS: DOJUMP ;HALT,JMP - Interpet JMP, treat HALT as EOF
DOSVW ;SVW - Short Vector Word
IINOP ;JMS,JSR,SAVE - [Ignore, readonly]
DOLVW ;LVW - Long Vector Word
IINOP ;SEL - Select [Ignore, doesn't apply]
DOTSS ;TSS - Test flags
IINOP ;REST - Restore [Ignore, since SAVE doesn't work]
IINOP ;???
; No op
IINOP: AOJA IIIPC,IILOOP
; Interpet text
DOTEXT: JUMPE RET,IINOP ;A word of nulls is a nop
MOVEI RET,$SGTXT ;Emit begin segment text
PUSHJ P,IMPOCHR
MOVEI B,1 ;Count number of words of text (min = 1)
MOVE C,IIIPC ;Save address of instruction
DOTEX1: ADDI IIIPC,1 ;Look forward for more text
CAMN IIIPC,IIIEND ;Watch for end (we don't want RELCHK to see it)
JRST DOTEX2 ;Found!
PUSHJ P,RELCHK ;Get word into core
MOVE RET,@IIIPC ;Another text word?
CAIN RET,1 ;Ignore text with just 1
JRST DOTEX2
TRNE RET,1
AOJA B,DOTEX1 ;;Yes, look for more, counting as we go
DOTEX2: MOVE IIIPC,C ;Get back to beginning of text
MOVEI RET,5 ;Calculate number of bytes
IMULM B,RET
PUSHJ P,SNDCNT ;Put out graphic style count
DOTEX3: MOVE C,[POINT 7,@IIIPC] ;Get ready to put out text
PUSHJ P,RELCHK ;Get word into core
DOTEX4: ILDB RET,C ;Get a character from III program
PUSHJ P,IMPOCHR ;Send it out
CAME C,[POINT 7,@IIIPC,34] ;Last byte in word?
JRST DOTEX4 ;No, send some more characters
ADDI IIIPC,1 ;Look at next word
SOJG B,DOTEX3 ;But only if we know it's text
JRST IILOOP ;Done with string of text
; Interpet JMP and HALT
DOJUMP: TRNN RET,20 ;JMP?
JRST IIDONE ;No, HALT. We're done
HLR IIIPC,RET ;Yes, set PC
JRST IILOOP
; Interpet Long Vector Word
DOLVW: MOVE B,RET ;Copy instruction
MOVE C,RET
AND B,[777600,,] ;Get X coordinate
ROT C,=11 ;Get Y coordinate
AND C,[777600,,]
ROT RET,-4 ;Get vector type
ANDI RET,7
TRZN RET,4 ;Relative vector?
JRST [ ADDB B,IIIX ;Do arithmetic here
ADDB C,IIIY
JOV [ MOVEI RET,WRAPBIT ;Watch for wraparound!
ORM IIFLAG-NUSERS(U)
JRST DOLVW2 ]
JRST DOLVW2 ]
MOVEM B,IIIX ;New X & Y
MOVEM C,IIIY
DOLVW2: MOVE RET,VECTYP(RET) ;Emit appropriate vector opcode
PUSHJ P,IMPOCHR
PUSHJ P,EDGTST ;Check for edge overflow and send coordinates
AOJA IIIPC,IILOOP ;Next instruction
; Interpet Short Vector Word
DOSVW: PUSHJ P,DOSVW2 ;Do first vector
MOVE RET,@IIIPC
LSH RET,=16
PUSHJ P,DOSVW2 ;Do second vector
AOJA IIIPC,IILOOP ;Next instruction
; Interpet half of Short Vector Word
DOSVW2: MOVE B,RET ;Copy instruction
ASH B,-4 ;Get X coordinate
AND B,[777600,,0]
MOVE C,RET
LSH C,7 ;Get Y coordinate
ASH C,-4
AND C,[777600,,0]
ADDB B,IIIX ;Short vectors are always relative
ADDB C,IIIY
JOV [ MOVEI RET,WRAPBIT ;Watch for wraparound!
ORM RET,IIFLAG-NUSERS(U) ;Turn on bits in flag word
JRST .+1 ]
LDB RET,[POINT 2,RET,15] ;Get vector type
MOVE RET,VECTYP(RET)
PUSHJ P,IMPOCHR ;Send NGP command
; Fall thru into EDGTST
; Send vector coordinates
EDGTST: MOVM RET,B ;Check for edge overflow
TLNE RET,200000
JRST EDGTS2
MOVM RET,C ;Both X and Y
TLNN RET,200000
JRST EDGTS3 ;Both OK, send coordinates
EDGTS2: MOVEI RET,EDGEBIT
ORM RET,IIFLAG-NUSERS(U) ;Turn on bits in flag word
EDGTS3: LSH B,1 ;For now, just wraparound on overflow!
LSH C,1
JRST SNDCOORD
; Mapping of III vector types onto NGP opcodes
VECTYP: $SGDRW ;Visible
$SGDOT ;Dot
$SGMOV ;Invisible
$SGDOT ;Undefined, currently dot on III
; Interpete TSS instruction
DOTSS: LDB B,[POINT 8,RET,23] ;Do test first
TDNN B,IIFLAG-NUSERS(U) ;Skip if any bits set
TRNN RET,20 ;Invert skip perhaps
ADDI IIIPC,1
LDB B,[POINT 8,RET,7] ;Clear bits
LDB C,[POINT 8,RET,15] ;Set bits
MOVE RET,A ;If both on, compliment!
AND RET,B
ANDCM B,RET ;Turn off complimented bits
ANDCM C,RET
ANDCAM B,IIFLAG-NUSERS(U) ;Do clears
IORM C,IIFLAG-NUSERS(U) ;Do sets
XORM RET,IIFLAG-NUSERS(U) ;Do complimenting
AOJA IIIPC,IILOOP
;Nothing can be on stack when RELCHK is called!!!
RELCHK: CAMLE IIIPC,IIIMIN ;Check to see if in core
CAML IIIPC,IIIMAX
JRST NOTIN ;Not in core, check address
POPJ P, ;OK, return
NOTIN: CAMLE IIIPC,IIIBEG ;Within display buffer?
CAML IIIPC,IIIEND
JRST [ CAME IIIPC,IIIMAX ;No. Check to for running off end
JRST ADRCHK ;No! Address out of bounds
POP P,(P) ;Flush RELCHK's return addess
JRST IIDONE ] ;Assume he forgot HALT
ADDI RELOC,(IIIMIN) ;Set up my address of block
MOVE IIIMIN,IIIPC ;Calculate - number of words to read
SUB IIIMIN,IIIEND
CAMGE IIIMIN,[-=1024] ;Too many?
MOVNI IIIMIN,=1024 ;YES, USE BLOCK SIZE
MOVEI IIIMAX,(IIIPC) ;Set up -<word count>,<users address>
HRL IIIMAX,IIIMIN
MOVE IIIMIN,-4(P) ;GET JOB NUMBER TO READ FROM
MOVEI RET,IIIMIN
JOBRD RET,
JRST JRDER2 ;Can't read it!!!
HLRO IIIMAX,IIIMAX ;Setup IIIMAX, IIIMIN, RELOC
SUBM IIIPC,IIIMAX
MOVE IIIMIN,IIIPC
SUBI RELOC,(IIIMIN)
POPJ P, ;Return
JRDER2: SETZ IIIMIN, ;It'll be wrong since RELOC=base of buffer
SKIPA RET,[[ASCIZ/Can't read display buffer of user job/]]
ADRCHK: MOVEI RET,[ASCIZ/Display instruction out of bounds/]
POP P,(P) ;Flush return address from RELCHK
IIIERR: PUSH P,RET ;Argument for IMPSTR
; PUSHJ P,IMPOUT ;Flush Graphics channel first
; SUBI U,NUSERS ;Use TELNET stream
; SUBI A,3*NUSERS
PUSH P,[[ASCIZ/
*** /]]
PUSHJ P,GRFERM
PUSHJ P,GRFERM
PUSH P,[[ASCIZ/ - IIISIM ***
/]]↔ PUSHJ P,GRFERM
; ADDI U,NUSERS
IIDONE: MOVEI RET,$SGCLS ;Close segment
PUSHJ P,IMPOCHR
MOVEI RET,$SGPOS ;Post it so it will be seen
PUSHJ P,IMPOCHR
MOVE RET,-1(P)
PUSHJ P,SNDNAM
MOVEI RET,$ENDUP ;Force up date so it will be seen now
PUSHJ P,IMPOCHR
PUSHJ P,IMPOUT
SKIPN RELOC
JRST QRET
ADDI RELOC,(IIIMIN) ;Get address of free storage block
PUSH P,RELOC
PUSHJ P,REL1K
QRET:; POP P,(P)
; POPJ P,
ENTERLOCK DPYLOK ;Check for someone else waiting
PUSH P,U
PUSH P,[GRFQUE]
PUSHJ P,SRHQUE
JUMPN RET,[ PUSH P,RET ;Yes, schedule to run
PUSH P,[PRIQUE]
PUSHJ P,ENQUE
AOS RUNWAIT ;Another process waiting for service
JRST NOTWAI ]
SETZM DPYUSE-NUSERS(U) ;Release display channel
NOTWAI: LEAVELOCK DPYLOK
SUB P,[XWD 4,4]
JRST @4(P)
BEND IIISIM
>;IFN GRFPRO
SUBTTL SNDCOOR- Send coordinates
IFN GRFPRO,<
BEGIN SNDCOORD
;
; Called with:
; MOVE B,[<X>] ;Where X is from -377777777777 to 377777777777
; MOVE C,[<Y>]
; PUSHJ P,SNDCOORD
; Destorys RET,B,C
;
↑SNDCOORD:
PUSH P,D ;Save an AC
MUL C,YMUL-NUSERS(U) ;Result into C, clobbering D
ADD C,YK-NUSERS(U)
MOVE D,C ;Save result
MUL B,XMUL-NUSERS(U) ;Result into B, clobeering D
ADD B,XK-NUSERS(U)
MOVE RET,B ;Do X first
PUSHJ P,SNDONE
MOVE RET,D ;Then Y
PUSHJ P,SNDONE
POP P,D ;Restore D
POPJ P,
;Send one coordinate
SNDONE: ROT RET,@ROTS-NUSERS(U) ;Amount to rotate to position high order byte
MOVE B,BYTES-NUSERS(U) ;Number of bytes
COLOOP: ROT RET,8 ;Get next byte
PUSHJ P,IMPOCHR ;Output a byte
SOJG B,COLOOP ;For each byte
POPJ P,
BEND SNDCOORD
>;IFN GRFPRO
SUBTTL SNDCNT - Send count (for NGP)
IFN GRFPRO,<
BEGIN SNDCNT
;
; Called with:
; MOVE RET,[<count>]
; PUSHJ P,SNDCNT
; Destroys RET
;
↑SNDCNT:CAIGE RET,200 ;Fit in one byte?
JRST IMPOCHR ;Sure, this is easy
ROT RET,-8 ;No, output higher order bits
ADDI RET,200 ;Plus
PUSHJ P,IMPOCHR
ANDCMI RET,377 ;Turn off higher order bits
ROT RET,8 ;Get back low order bits
JRST IMPOCHR ;And output them too
BEND SNDCNT
>;IFN GRFPRO
SUBTTL STRLEN - Length of ASCIZ string
IFN GRFPRO,<
BEGIN STRLEN
;
; Called with:
; PUSH P,[[ASCIZ/<string>/]]
; PUSHJ P,STRLEN
; Destroys RET
;
↑STRLEN:PUSH P,TAC ;Save an AC
SETZ RET, ;Init count
SNDLE1: ILDB TAC,-1(P) ;Send each character
JUMPE TAC,[POP P,TAC ; Until NULL is found
SUB P,[XWD 2,2]
JRST 2(P)]
AOJA RET,SNDLE1
BEND STRLEN
>;IFN GRFPRO
SUBTTL SNDSTR - Send string (for NGP)
IFN GRFPRO,<
BEGIN SNDSTR
;
; Called with:
; PUSH P,[[ASCIZ/<string>/]]
; PUSHJ P,SNDSTR
; Destroys RET
;
↑SNDSTR:
HLLZ RET,-1(P) ;Pick up byte part of string pointer
JUMPN RET,SNDST1 ; It's good, use it!
MOVSI RET,(<POINT 7,0>) ;Make into string pointer
HLLM RET,-1(P)
SNDST1: PUSH P,-1(P) ;Get length of string
PUSHJ P,STRLEN
PUSHJ P,SNDCNT ;Graphics format begins with string length
SNDST2: ILDB RET,-1(P) ;Send each character
JUMPE RET,[SUB P,[XWD 2,2] ;Until NULL is found
JRST 2(P)]
PUSHJ P,IMPOCHR
JRST SNDST2
BEND SNDSTR
SUBTTL SNDNAM - Send segment name (for NGP)
;
; Called with:
; MOVEI RET,<segment number>
; PUSHJ P,SNDNAM
;
SNDNAM: ROT RET,-8
PUSHJ P,IMPOCHR ;Send high order 8 bits
ROT RET,8
JRST IMPOCHR ;Send low order 8 bits
>;IFN GRFPRO
;-------------------------------------------------
SUBTTL GET1K - Get a 1024 word block
BEGIN GET1K
;
; Called with:
; PUSHJ P,GET1K
; Return address of block in RET
;
↑GET1K: ENTERLOCK .1KLOK ;Interlock against modifying 1K free list
SKIPN RET,FREE1K ;Any blocks handy?
JRST GETCOR ;No, get one from system
PUSH P,RET ;Yes, save its address
HRRZ RET,(RET) ;And get next free one if any
MOVEM RET,FREE1K ;for the next time thru
RETURN: POP P,RET ;Get back block to return
LEAVELOCK .1KLOK ;Interlock against modifying 1K free list
POPJ P, ;and return
GETCOR: PUSHJ P,USERMODE ;Make sure we're at user level!!!
MOVE RET,JOBREL↑
ADDI RET,1 ;Address of new block
PUSH P,RET
; ORI RET,=1023 ;System will do this, included for clarity
CORE RET,
PUSHJ P,DRYROT ;Lose big!!!
JRST RETURN
BEND GET1K
SUBTTL REL1K - Release a 1024 word block
BEGIN REL1K
; Called with:
; PUSH P,[<block address>]
; PUSHJ P,REL1K
; Preserves all ACS
;
↑REL1K: ENTERLOCK .1KLOK ;Interlock against modifying 1K free list
EXCH TAC,-1(P) ;Get address of block and save AC
MOVEI TAC,=1024-1(TAC) ;Top of core perhaps
CAME TAC,JOBREL↑
JRST NOTTOP ;Didn't think so
SUBI TAC,=1024 ;Yes, let's core down then
CORE TAC,
PUSHJ P,DRYROT ;Should NEVER lose
JRST RETURN
NOTTOP: SUBI TAC,=1024-1 ;Restore pointer to block
EXCH TAC,FREE1K ;Get old head and save new
MOVEM TAC,@FREE1K ;Point new at old
RETURN:
LEAVELOCK .1KLOK ;Interlock against modifying 1K free list
MOVE TAC,-1(P) ;Restore AC
SUB P,[XWD 2,2]
JRST @2(P) ;And return
BEND REL1K
SUBTTL MKPBLK - Make a Process Block
BEGIN MKPBLK
;
; PUSHJ P,MKPBLK
; Returns address of process in RET
; Destroys TAC, TAC2
;
↑MKPBLK:
;Turn off interrupts as following is not reentrant
PUSH P,A
ENTERLOCK PBKLOK ;Interlock against modifying process block free list
GOTBLK: SKIPN RET,PROCFR ;Get a procedure block
JRST NOPROC ;None left!!!
MOVE TAC,%LINK(RET) ;Make point to free next procedure
HLRZM TAC,PROCFR
;Restore interrupts now
LEAVELOCK PBKLOK ;Interlock against modifying process block free list
POP P,A
POPJ P, ;And return
NOPROC: SKIPN INTLEV ;At interrupt level
JRST NOTINT
PUSHJ P,USERMODE ;Enter user mode
MOVE A,LOKMSK ;*** KLUDGE ***
SETZM LOKMSK
MOVEM A,OLDMSK
NOTINT: PUSHJ P,GET1K ;Get a 1K block
MOVEI TAC,=1024-1(RET) ;End of block
MOVEM TAC,BLKEND
MOVE TAC,RET
MOVSI TAC2,-%PDLSZ
ADDI TAC,PROCSZ-1 ;Point to end of block
NWLOOP: HRRI TAC2,-PROCSZ(TAC) ;Make an IOWD
MOVEM TAC2,%PDLIO(TAC) ;Now, set up PDL pointer
ADDI TAC,PROCSZ ;Point to end of block
CAMG TAC,BLKEND ;Past last?
JRST [ HRLZM TAC,%LINK-PROCSZ(TAC) ;And pointer to next block
JRST NWLOOP ]
SETZM %LINK-PROCSZ(TAC) ;Last pointer out of bounds, make end mark
ADDI RET,PROCSZ-1 ;Now, make pointer to first one
MOVEM RET,PROCFR
JRST GOTBLK ;This can have the timing loss of invoking processes
;in the wrong order from interrupt level.
ARRAY ACSAVE[20]
INTEGER BLKEND
BEND MKPBLK
SUBTTL MKPROC - Make a Process
BEGIN MKPROC
;
; PUSH P,<PC of process on stack>
; PUSHJ P,MKPROC
; Returns address of process in RET
; Destroys TAC, TAC2
; Calls MKPBLK
;
↑MKPROC:
;Turn off interrupts as following is not reentrant
PUSHJ P,MKPBLK ;Get a process block
HRRZM U,%USER(RET) ;Owning User number
AOS %USER(RET) ; + 1
HRLM U,%USER(RET) ;Set Datum to user number as default
MOVE TAC,%PDLIO(RET) ;Set up enviroment
EXCH TAC,P ;Use new stack
PUSH P,[PREXIT] ;So process exits with a POPJ
PUSH P,-1(TAC) ;PC for process
exch tac2,(p)
hrrz tac2,tac2
cail tac2,$bgnet
caile tac2,endcod
jrst [ exch tac2,(p)
outstr[asciz/Attempt to create process with PC out of bounds!/]
pushj p,dryrot
movei tac2,prexit
jrst .+1]
exch tac2,(p)
PUSHACS
SUBI P,17
HRROM P,%PACS(RET) ;Copy of P (also obliterate old free storage pointer
;so if a routine tries to reference it uninitialized,
;it will get an ILL MEM REG).
MOVE P,TAC ;Get back old stack
POP P,-1(P) ;Flush arg from stack
POPJ P, ;And return
BEND MKPROC
SUBTTL KLPROC - Kill a Process or Process Block
BEGIN KLPROC
;
; Process pointer on stack
; Destroys TAC, TAC2
;
↑KLPBLK:
↑KLPROC:
ENTERLOCK PBKLOK ;Interlock against modifying process block free list
HRRZ TAC,-1(P) ;Pick up process header.
CAML TAC,OLDFF ;Address check it
CAMLE TAC,JOBREL↑
;**** This is where alot of errors happen! ****
PUSHJ P,DRYROT
; SKIPGE %PDLIO(TAC) ;More checking, that should be an IOWD
; SKIPG %LINK(TAC) ;That should be an queue pointer, hence positive
; PUSHJ P,DRYROT
EXCH TAC,PROCFR ;New free block
MOVSM TAC,@PROCFR ;Link to next free block
LEAVELOCK PBKLOK ;Interlock against modifying process block free list
POP P,-1(P) ;Flush arg
POPJ P, ;And return
BEND KLPROC
SUBTTL ENQUE - Enter into Queue
BEGIN ENQUE
;
; PUSH P,<process pointer>
; PUSH P,<queue>
; PUSHJ P,ENQUE
;
; Destroys TAC, TAC2
;
↑ENQUE:
ENTERLOCK QUELOK ;Interlock against queue modification
;Stack: <process pointer>,<queue>,<return address>
MOVE TAC,-2(P) ;Get process pointer
MOVE TAC2,-1(P) ;And queue block
HRRZS %LINK(TAC) ;Mark end of queue
SKIPN (TAC2) ;Empty queue?
JRST [ MOVEM TAC,(TAC2) ;Yes, make it head also as well as tail
JRST RETURN ]
HRLM TAC,@1(TAC2) ;Store pointer to next last queue element
RETURN: MOVEM TAC,1(TAC2) ;Move into end of queue marker
AOS 2(TAC2) ;Increment number in queue
LEAVELOCK QUELOK ;Interlock against queue modification
SUB P,[XWD 3,3] ;Flush stack
JRST @3(P) ;And return
BEND ENQUE
COMMENT ⊗ NOT USED
---------------------------------------------------------------------
SUBTTL ENHQUE - Enter into Head of Queue
BEGIN ENHQUE
;
; PUSH P,<process pointer>
; PUSH P,<queue>
; PUSHJ P,ENTQUE
;
; Destroys TAC, TAC2
;
↑ENHQUE:PUSH P,[-1] ;Turn off interrupts as following is not reentrant
; IMSKCR (P)
ENTERLOCK QUELOK ;Interlock against queue modification
;Stack: <process pointer>,<queue>,<return address>,<interrupt mask>
MOVE TAC,-3(P) ;Get process pointer
MOVE TAC2,@-2(P) ;Point it to new element at old one (if any)
HRLM TAC2,%LINK(TAC)
MOVEM TAC,@-2(P) ;New head of queue
JUMPN TAC2,NOTEMP ;Was it empty before?
MOVE TAC2,@-2(P)
MOVEM TAC,1(TAC2) ;New tail too.
NOTEMP: MOVE TAC2,@-2(P)
AOS 2(TAC2) ;Increment number in queue
; INTMSK 1,(P) ;Restore interrupts
LEAVELOCK QUELOK ;Interlock against queue modification
SUB P,[XWD 4,4] ;Flush stack
JRST @3(P) ;And return
BEND ENHQUE
---------------------------------------------------------------------
⊗;
SUBTTL ENTCLK - Enter into Clock Queue
BEGIN ENTCLK
;
; PUSH P,<process pointer>
; PUSH P,<number of tics to delay> ;(up to 2↑18)
; PUSHJ P,ENTCLK
;
; Destroys TAC, TAC2
;
; This routine enters a process into the Clock Queue (CLKQUE) so that it will
; be run at that time. It looks at the front of the queue and inserts it in
; front if it will happen before the next scheduled interrupt. Otherwise, it
; looks down the queue, subtracting the time increment of each entry, and until
; an entry is found which will occur after that process.
;
↑ENTCLK:PUSH P,A ;Save an AC
ENTERLOCK QUELOK ;Interlock against queue modification
;Stack: <process pointer>,<number of tics>,<return address>,<old A>
; -3 -2 -1 0
SKIPE TAC,-2(P) ;Bless the time increment
TLNE TAC,777777
PUSHJ P,DRYROT
TIMER A, ;Pick up current time (tics past midnight)
ADDB TAC,A ;Add current time to find time of new interrupt
SKIPN TAC2,NXTTIM ;Anything queued?
JRST EMPTY ;And put in front of queue
SUBM TAC,TAC2 ;Difference between new and old interrupts
JUMPL TAC2,BEFORE ;New once occurs before first in queue
CAMG TAC2,[DAYTIC/2] ;Did we pass midnight
JRST AFTER ;No, happens sometime after first entry in queue
ADD TAC2,[DAYTIC] ;Yes, figure time as on a two day basis
JUMPL TAC2,BEFORE ;Gee, it's before first time queue after all
AFTER: HRLO TAC2,TAC2 ;Move into left halt. 777777 in the right half
;guarantees that when the other half of the datum
;word is subracted, it will not carry into left half.
SKIPA A,CLKQUE ;Pick up head of the clock queue
AFLOOP: MOVE A,TAC ;Remember address of previous node for insertion
HLRZ TAC,(A) ;Get next node
JUMPE TAC,ATEND ;No more, insert at end of queue
SUB TAC2,%DATUM(TAC) ;Insert here?
JUMPGE TAC2,AFLOOP ;No, later than that
ADD TAC2,%DATUM(TAC) ;Yes! Compensate of over-subtraction (a la division).
HLLZ TAC2,TAC2 ;Flush garbage from right half of datum word
MOVN TAC2,TAC2 ;Update time increment for next node
ADDM TAC2,%DATUM(TAC)
MOVN TAC2,TAC2
ATEND: HRLM TAC,@-3(P) ;Point current node at next node
MOVE TAC,-3(p)
HRLM TAC,%LINK(A) ;And previous node at current node
HLLM TAC2,%DATUM(TAC) ;Set time increment from previous interrupt
RETURN: AOS CLKQUE+2 ;Increment number of entries in the queue
LEAVELOCK QUELOK ;Interlock against queue modification
POP P,A ;Restore A
SUB P,[XWD 3,3] ;Flush garbage on stack
JRST @3(P)
BEFORE: MOVN TAC,TAC2 ;Set increment for old head of queue
MOVE TAC2,CLKQUE
HRLM TAC,%DATUM(TAC2)
EMPTY: MOVE TAC,-3(P) ;Point current node at old head of queue
HRLM TAC2,%LINK(TAC)
IFN DEBPRC,<
skipn clkque
outchr ["≤"]
>;IFN DEBPRC
MOVEM TAC,CLKQUE ;We now have a new head of queue
MOVEM A,NXTTIM ;What time next interrupt will be. We have to
;save this as the system will not guarantee
;that we will be started up exactly when we
;requested
CLKINT 1,@-2(P) ;Actual interrupt request
TURNON [CLKINT]
JRST RETURN
BEND ENTCLK
SUBTTL DEQUE - Delete first entry from queue
BEGIN DEQUE
;
; PUSH P,<queue>
; PUSHJ P,DEQUE
;
; Process pointer returned in RET
; Destroys TAC, TAC2
;
↑DEQUE: ENTERLOCK QUELOK ;Interlock against queue modification
;Stack: <queue>,<return address>
MOVE TAC,-1(P) ;Get queue pointer
HRRZ RET,(TAC) ;Pick up first in queue
JUMPE RET,EMPTY
HLRZ TAC2,%LINK(RET) ;Pick up next in queue
MOVEM TAC2,(TAC) ;New head of queue
JUMPN TAC2,.+2 ;Last in queue?
MOVEM TAC2,1(TAC) ;Yes, zero last pointer in queue
SOSGE 2(TAC) ;Decrement number in queue
PUSHJ P,DRYROT
EMPTY: LEAVELOCK QUELOK ;Interlock against queue modification
SUB P,[XWD 2,2] ;Flush stack
JRST @2(P) ;And return
BEND DEQUE
SUBTTL SRHQUE - Search queue and delete entry
BEGIN SRHQUE
;
; PUSH P,<datum to search for>
; PUSH P,<queue>
; PUSHJ P,SRHQUE
;
; Process pointer returned in RET
; Destroys TAC, TAC2
;
; This subroutine searches a queue for an matching datum. If the queue
; is empty or no entry matches, zero is returned. If entry matches, the
; first such entry is unlinked from the queue (by remembering ancestor) and
; returned.
;
↑SRHQUE:
ENTERLOCK QUELOK ;Interlock against queue modification
;Stack: <datum>,<queue>,<return address>
; -2 -1 0
HRRO TAC,-1(P)
MOVE RET,(TAC) ;First node in queue
JUMPE RET,RETURN ;Not found
LOOP: HLRZ TAC2,%DATUM(RET) ;Check datum
CAMN TAC2,-2(P)
JRST [ HLRZ TAC2,%LINK(RET) ;Point previous at next
JUMPE TAC2,SETTL
JUMPL TAC,SETHD ;Check for head of queue
HRLM TAC2,%LINK(TAC) ;Normal node
SKIPA TAC,-1(P) ;Get head of queue
SETHD: HRRZM TAC2,(TAC) ;(From above) Special case of head of queue
SOSGE 2(TAC) ;Decrement number in queue
PUSHJ P,DRYROT
JRST RETURN
SETTL: JUMPL TAC,[MOVE TAC,-1(P) ;Watch for empty case
SETZB TAC2,1(TAC) ;Zero end marker
JRST SETHD] ;Set head to nothingness
HRRZS %LINK(TAC) ;Mark end of list with zero
MOVE TAC2,-1(P) ;Get head of queue
HRRZM TAC,1(TAC2) ;Set tail of queue
SOSGE 2(TAC2)
PUSHJ P,DRYROT
JRST RETURN ]
MOVE TAC,RET ;Old previous node
HLRZ RET,%LINK(TAC) ;New node to check
JUMPN RET,LOOP
RETURN: LEAVELOCK QUELOK ;Interlock against queue modification
SUB P,[XWD 3,3] ;Flush stack
JRST @3(P) ;And return
BEND SRHQUE
SUBTTL SCHED - Schedule a Process
BEGIN SCHED
;
; PUSH P,<PC of process on stack>
; PUSHJ P,MKPROC
; Returns address of process in RET
; Calls MKPBLK
;
↑SCHED:
IFN DEBPRC,<
SKIPN DEBUG
OUTCHR ["+"]
>;IFN DEBPRC
PUSH P,U ;Save U
HRRZ U,U ;Interrupt routines like to use left half
PUSH P,-2(P) ;Create a process
PUSHJ P,MKPROC
PUSH P,RET ;Queue it to run
PUSH P,[RUNQUE]
PUSHJ P,ENQUE
AOS RUNWAIT ;Increment number of processes waiting to be run
POP P,U ;Return U
POP P,-1(P) ;Flush arg from stack
POPJ P, ;And return
BEND SCHED
SUBTTL RESCHED- Request to be Rescheduled (also WSCHED)
BEGIN RESCHED
;
; Called by process to let others run or to wait for something. Called by:
;
; PUSH P,[<queue to wait in>]
; PUSHJ P,RESCHED ;to run (use WSCHED to wait)
;
; All AC's and flags are preserved
;
↑RESCHED:
AOS RUNWAIT ;Increment number of processes waiting to be run
↑WSCHED:
IFN DEBPRC,<
SKIPE DEBUG
OUTCHR ["+"]
>;IFN DEBPRC
;**** This should be fixed to avoid temperaries!!! ****
ENTERLOCK QUELOK ;Impure code, need to interlock
POP P,TEMP1 ;Save return address
POP P,NEWQUE ;Save new queue
; exch tac,temp1
; cail tac,$bgnet
; caile tac,endcod
; jrst [ exch tac,temp1
; exch p,sys.p
; pushj p,dryrot
; jrst .-1 ]
PUSH P,TEMP1 ;Put return address back on stack
PUSHACS
PUSHJ P,GETPRO ;Get process pointer
SUB P,[XWD 17,17]
HRRM P,(TAC) ;Copy of P
; HLRO TAC,P ;Find top of stack
; SUBM P,TAC
; MOVEI TAC,-%PDLIO(TAC) ;This is a process pointer now
SKIPE INTLEV ;At interrupt level?
PUSHJ P,DRYROT ;Lose big!!
MOVE P,SYS.P
MOVEM P,LAST.P ;For debugging
SETZM SYS.P ;We're don't need it any more
PUSH P,TAC
PUSH P,NEWQUE
LEAVELOCK QUELOK
PUSHJ P,ENQUE
;*** The following crock is due to timing race in IMICHW and NETOPN ***
push p,tac
move tac,newque
cain tac,imwque
jrst [ leavelock imilok
turnon [intinp]
jrst foo ]
cain tac,imsque
jrst [ turnon [intims]
jrst foo ]
foo: pop p,tac
;*** End of IMICHW crock ***
POPJ P,
INTEGER TEMP1,NEWQUE
BEND RESCHED
SUBTTL DELAY - Schedule a Process in future
BEGIN DELAY
;
; PUSH P,<PC of process on stack>
; PUSH P,<number of tics to wait>
; PUSHJ P,DELAY
; Returns address of process in RET
; Calls MKPBLK
;
↑DELAY: PUSH P,-2(P) ;Create a process
PUSHJ P,MKPROC
PUSH P,RET ;Queue it to run
PUSH P,-2(P) ;Time (note P incremented by previous PUSH)
PUSHJ P,ENTCLK
SUB P,[XWD 3,3]
JRST @3(P)
BEND DELAY
SUBTTL POSTPON- Request to be Rescheduled
BEGIN POSTPONE
;
; Called by process to wait a specified length of time
;
; PUSH P,[<number of tics to wait>]
; PUSHJ P,POSTPONE
;
; All AC's and flags are preserved
;
↑POSTPONE:
PUSH P,TAC ;Save TAC
MOVE TAC,SYS.P ;Pick up system stack point
PUSH TAC,0 ;Push space for process pointer
PUSH TAC,-2(P) ;Push number of tic to wait
MOVEM TAC,SYS.P
POP P,TAC ;Get back TAC
POP P,-1(P) ;Flush time from stack
PUSHACS
PUSHJ P,GETPRO ;Get pointer to process
SUB P,[XWD 17,17]
HRRM P,(TAC) ;Copy of P
SKIPE INTLEV ;At interrupt level?
PUSHJ P,DRYROT ;Lose big!!
MOVE P,SYS.P
MOVEM P,LAST.P ;For debugging
SETZM SYS.P ;We're don't need to save system stack pointer
MOVEM TAC,-1(P) ;Set process pointer (save alreadly allocated on stack)
PUSHJ P,ENTCLK ;Enter into clock queue (args already on stack)
POPJ P, ;Return to invoker of process
BEND POSTPONE
SUBTTL RUNPROC- Run a Process
BEGIN RUNPROC
;
; Sets up process and runs it. Returns when done. Called with:
;
; PUSH P,<process pointer>
; PUSHJ P,RUNPROC
;
; Destroys TAC of caller. Process's AC's and flags are preserved.
;
↑RUNPROC:
IFN DEBPRC,<
SKIPE DEBUG
OUTCHR ["-"]
>;IFN DEBPRC
SOSGE RUNWAIT ;Decrement number of processes waiting to be run
JRST [PUSHJ P,DRYROT ;Over-SOS'ed it!!!
SETZM RUNWAIT
JRST .+1]
POP P,TAC ;Get PC
EXCH TAC,(P) ;Save and get process pointer
MOVEM TAC,LASTRUN ;For debugging, remember last process run
SKIPE SYS.P ;Make sure user process not trying to run another
PUSHJ P,DRYROT ;Oops!
MOVEM P,SYS.P ;Save system stack pointer
HRRZ TAC,%LINK(TAC) ;Pick up pointer to AC's on stack
MOVSI P,(TAC) ;Load AC's
BLT P,P
HRRE 0,-1(P) ;Bless the PC
; JUMPLE 0,BADPC ;Oops!
CAIL 0,$BGNET
CAILE 0,ENDCOD
JRST BADPC
POP P,0 ;On last AC.
POP P,LASTPC ;Remember for debugging (we couldn't POPJ and get
;flags anyway)
JRST 2,@LASTPC ;Restore flags
BADPC:
OUTSTR[ASCIZ/Process PC out of bounds./]
exch p,sys.p
skipe debug
pushj p,dryrot
exch p,sys.p
OUTSTR[ASCIZ/..Flushed!
/]↔ JRST PREXIT
BEND RUNPROC
SUBTTL PREXIT - Process Exit
BEGIN PREXIT
↑PREXIT:
PUSHJ P,GETPRO ;Get process pointer
SKIPE INTLEV ;At interrupt level?
PUSHJ P,DRYROT ;Lose big!!
MOVE P,SYS.P ;Get back system's stack pointer
MOVEM P,LAST.P ;For debugging
SETZM SYS.P ;We're done with it now.
PUSH P,TAC ;Kill the dead process
PUSHJ P,KLPROC
POPJ P,
BEND PREXIT
SUBTTL GETPRO - Get process pointer from stack pointer
;
; PUSHJ P,GETPRO
; Returns stack pointer in TAC
;
GETPRO: HLRO TAC,P ;Find top of stack
SUBM P,TAC
MOVEI TAC,1-%PDLIO(TAC) ;This is a process pointer now
POPJ P,
SUBTTL GTUSID - Get User Id
BEGIN GTUSID
↑GTUSID:MOVE TAC,USEMAP ;Pick up bit map of available slots
JFFO TAC,GOTONE ;Any
PUSHJ P,DRYROT ;Lose big!
GOTONE: MOVE U,TAC2 ;Give him/her a number
MOVSI TAC,400000 ;Turn off appropriate bit
MOVN TAC2,U
ROT TAC,(TAC2)
ANDCAB TAC,USEMAP
AOS USERS ;Increment number of users
JUMPN TAC,SETU ;If no more slots left,
MOVE TAC,[SIXBIT/ NTGRF/] ;Then change name so LOGGER
SETNAM TAC, ;doesn't send us any more mail
PUSH P,U ;Save while we flush U.ICP
MOVEI U,U.ICP
SETZ A,
PUSHJ P,KLUSER ;Flush the ICP for now
POP P,U
SETU: PUSHJ P,GETPRO ;Get process pointer
HRRM U,%USER(TAC) ;Set correct user
POPJ P, ;And return ID
BEND GTUSID
SUBTTL KLUSER - Kill user and release associated storage ***
BEGIN KLUSER
;
; MOVE U,<user number>
; PUSHJ P,KLUSER
;
↑KLUSER:
JUMPE A,KLUSE2 ;Quiet flush.
SKIPN DEBUG
jrst [
MOVE TAC,A
PUSHJ P,LOGIT
XWD 7,[ASCIZ/Killing #/]
XWD =10,U
XWD 7,[ASCIZ/: /]
XWD =11,TAC
0
JRST KLUSE2 ]
OUTSTR (A)
OUTSTR[ASCIZ/Killing user number /]
PUSH P,U
PUSHJ P,TYPDEC
; Search down the queues and kill any processes belonging to this user
KLUSE2: PUSH P,A ;Get a permanent AC
PUSH P,B
PUSH P,C
PUSH P,[-1] ;Best be done with interrupts off!
IMSKCR (P)
MOVE A,[XWD -NQUES,BEGQUE] ;Pointer to all queues
MOVEI B,PREXIT ;We will force any process pending for this job to exit
QLOOP: MOVE TAC,(A) ;Get first entry in queue
MOVEI C,100 ;Limit number of times thru loop
PLOOP: JUMPE TAC,QEND ;End check
SOJL C,[PUSHJ P,DRYROT
JRST QEND]
HRRZ TAC2,%USER(TAC) ;One of his/hers?
IFN GRFPRO,<
CAIGE U,NUSERS
CAIE TAC2,NUSERS+1(U)
>;IFN GRFPRO
CAIN TAC2,1(U) ;User number + 1 in process block (for ENTCLK)
JRST[ HRRZ TAC2,%PACS(TAC) ;Pointer to acs
MOVEM B,-1(TAC2) ;Mung PC to run PREXIT when it is invoked.
JRST .+1 ]
HLRZ TAC,(TAC) ;Pick up next entry in queue
JRST PLOOP ;No, look for more
;Current queue has been checked
QEND: ADDI A,QUESIZ-1 ;Any more queues to check?
AOBJN A,QLOOP ;Yep
HRRZ TAC,PTYNUM(U) ;Did user get a PTY?
CAIL U,NUSERS ;Is it really a PTY
JRST NOTPTY ;No
JUMPE TAC,NOTPTY
;Robert E. Mass Memorial job detach code
TTYJOB TAC, ;Get job number if any
JUMPE TAC,NOTPTY
MOVEI TAC2,211 ;Access system's PRJPRG table
PEEK TAC2,
ADD TAC2,TAC
PEEK TAC2,
HRRZ TAC2,TAC2
CAIE TAC,'TVR' ;I think i'll try it too. TVR
CAIN TAC2,'REM'
JRST[ MOVE TAC,PTYNUM(U) ;Clear the input buffer
MOVEI TAC2,7
PTJOBX TAC
MOVEI TAC2,[BYTE (9) 600,600,"D","E","T",12,0]
PTWRS9 TAC ;Send ↑C ↑C DET <lf>
SETZ TAC,
SLEEP TAC, ;Wait a tick for system to gobble
JRST NOTREM] ;characters
NOTREM: PTYREL PTYNUM(U) ;Yes, release its PTY
NOTPTY: SETZM PTYNUM(U) ;Forget we had it
SETZM PTIFUL(U) ;Forget there might be a process using this channel
SETOM WHRTAB(U) ;Zap his/her WHERE table entry
PUSHJ P,KLIMP ;Kill IMP connection
IFN GRFPRO,
< CAIL U,NUSERS ;Is it a graphics connection being killed?
JRST ISGRF
SETZM DPYFLG-NUSERS(U) ;Zero display mode flag
ADDI U,NUSERS
PUSHJ P,KLIMP ;Don't forget graphics connection
SUBI U,NUSERS
>;IFN GRFPRO,
MOVSI TAC,400000 ;Release user id
MOVN TAC2,U
ROT TAC,(TAC2)
ORM TAC,USEMAP
ISGRF: SKIPE DEBUG
OUTSTR CRLF
INTMSK 1,(P) ;Restore interrupts
POP P,(P) ;Flush interrupt mask
POP P,C
POP P,B ;Restore old acs
POP P,A
IFN GRFPRO,<
CAIL U,NUSERS ;Don't decrement user count for graphics
POPJ P, ;and return
>;IFN GRFPRO
PUSHJ P,OUTWHR ;Write out table again
SOSN TAC,USERS ;If not last user or debugging,
SKIPE DEBUG
JRST [ CAIE TAC,NUSERS-1 ;Did the last user just disperse?
POPJ P, ; No, done then
MOVE TAC,[SIXBIT/NETGRF/] ;Then set name to indicate we'll
SETNAM TAC, ;take another user
MOVEI U,U.ICP
PUSH P,[NEWICP] ;Start up new ICP
PUSHJ P,SCHED
POPJ P, ] ;And return
EXIT ;Otherwise, die quietly
;Kill IMP connection
KLIMP: MOVSI TAC,400000 ;Mark IMP connection as flushed
MOVN TAC2,U
ROT TAC,(TAC2)
TDNN TAC,IMPMAP ;If present
POPJ P, ;(Otherwise return)
MOVE A,U ;First, get user number
IDIVI A,NUSERS ;User number->B, Graphics if A=1
MOVE B,LSOCKT(U) ;Get local socket number
LSH A,1 ;Offset to socket number is 2
ADD B,A
MOVE TAC2,[MTAPE 000,A] ;Close both connections
DPB U,[POINT 4,TAC2,12]
MOVEI A,3 ;Opcode for TERMINATE
SETZ C, ;Don't wait, other users!
XCT TAC2 ;MTAPE 000,[TERMINATE]
CAIN U,U.ICP ;ICP socket?
JRST KLIMP2 ; Yeah, skip other side
ADDI B,1 ;Other half of connection
XCT TAC2 ;MTAPE 000,[TERMINATE]
; MOVE TAC2,[CLOSE 000,] ;Close IMP connection
; DPB U,[POINT 4,TAC2,12]
; XCT TAC2
KLIMP2: ANDCAM TAC,IMPMAP
MOVE TAC,[RELEASE 000,3] ;Release IMP connection
DPB U,[POINT 4,TAC,12]
XCT TAC ;RELEASE CHAN,3
CAIN U,U.ICP ;ICP socket?
POPJ P, ; Yeah, no buffers used
MOVEI A,3 ;Index for buffer headers
IMULM U,A
PUSH P,INHDR(A) ;Release its buffers
PUSHJ P,KLRBUF
PUSH P,OUTHDR(A)
PUSHJ P,KLRBUF
POPJ P,
BEND KLUSER
SUBTTL FNDPTY - Find user number from pseudoteletype line
BEGIN FNDPTY
;
;
; PUSH P,[<PTY number>]
; PUSHJ P,FNDPTY
; <failure return>
;
; Returns with user number in U. Destroys TAC
;
FNDPTY↑:MOVSI U,-NUSERS ;Set up for search
HRRZS -1(P) ;Flush status bits
FNDPT2: HRRZ TAC,PTYNUM(U) ;Get pty number
CAMN TAC,-1(P) ;That one?
JRST [ AOS (P) ;Yes, success
HRRZ U,U ;Flush AOBJN part
JRST RETURN ]
AOBJN U,FNDPT2 ;No, try again
SETO U, ;Lose!
RETURN: POP P,-1(P) ;Flush stack
POPJ P, ;And return
BEND FNDPTY
SUBTTL MKRBUF - Make Ring Buffers for System I/O
BEGIN MKRBUF
;
; PUSH P,[<number of buffers>]
; PUSH P,[<buffer size>]
; PUSHJ P,MKRBUF
;
↑MKRBUF:PUSH P,A ;Save A
MOVE TAC,-2(P) ;Check size
ADDI TAC,2
CAILE TAC,PROCSZ
PUSHJ P,DRYROT ;Oops!
PUSHJ P,MKPBLK ;Make a process block
SUBI RET,PROCSZ-2 ;Point to second word
HRLZ TAC,-2(P) ;Pick up buffer size
HRR TAC,RET ;Make pointer to next buffer (self)
MOVEM TAC,(RET)
PUSH P,RET ;Save address of first buffer
;Stack: <number of buffers>,<buffer size>,<return address>,<previous buffer>,<next buffer>
LOOP: MOVE A,RET ;Save address of previous buffer
SOSG -4(P) ;Enough?
JRST RETURN ;Yes, return
PUSHJ P,MKPBLK ;Get another process block
SUBI RET,PROCSZ-2 ;Point to second word
HRL A,-3(P) ;Pick up buffer size
MOVEM A,(RET) ;Point this buffer at previous buffer
JRST LOOP ;Put size in and test for end
RETURN: HRRM RET,@(P) ;Point last buffer to first to close the ring
HRLI RET,400000 ;Turn on high order bit to indicate unused buffer
MOVE A,-1(P) ;Restore A
SUB P,[XWD 5,5] ;Flush stack
JRST @3(P) ;And return
BEND MKRBUF
SUBTTL KLRBUF - Kill Ring Buffers
BEGIN KLRBUF
;
; PUSH P,<buffer pointer>
; PUSHJ P,KLRBUF
;
↑KLRBUF:PUSH P,A ;Get a handy permanent AC
HRRZS A,-2(P) ;Pick up first buffer
LOOP: ADDI A,PROCSZ-2 ;Make it into process block pointer
PUSH P,A ;Get ready to kill process block
HRRZ A,2-PROCSZ(A) ;Pick up next buffer before we do though
PUSHJ P,KLPBLK ;Kill it here
CAME A,-2(P) ;Back to first yet?
JRST LOOP ;No, flush another buffer and try again
POP P,A ;Get back that ac
POP P,-1(P) ;Flush arg
POPJ P, ;And return
BEND KLRBUF
SUBTTL ENLOCK - Enter interlock
BEGIN ENLOCK
;
; Called by:
; PUSHJ P,ENLOCK
; <interlock block>
; Preserves all AC's
; Note: this is generated by macro: ENTERLOCK
;
; *** The following is a kludge ***
↑ENLOCK:AOSE LOKCNT ;Already in interlock?
JRST RETURN ;Yes, just return then
push p,(p)
pop p,beglok
SKIPE INTLEV ;or at interrupt level
JRST RETURN ;Yes, just return then
IFN NEWSW,< PUSHJ P,DRYROT >
SETOM LOKMSK ;Save mask and disable interrupts
IMSKCR LOKMSK
RETURN: AOS (P) ;Skip over interlock block
IFN DEBPRC,<
skipe debug
outchr ["<"]
;We have to have a ">" to assemble correctly!!!!!
>;IFN DEBPRC
POPJ P,
BEND ENLOCK
SUBTTL DELOCK - Leave interlock
BEGIN DELOCK
;
; Called by:
; PUSHJ P,DELOCK
; <interlock block>
; Preserves all AC's
; Note: this is generated by macro: LEAVELOCK
;
; *** The following is a kludge ***
↑DELOCK:
skipge lokcnt ;*** Bug trap ***
jrst [ pushj p,dryrot
jrst return ]
SOSL LOKCNT ;In another interlock?
JRST RETURN
;↓↓↓ Bug trap
PUSH P,TAC
MOVE TAC,@-1(P)
CAME TAC,@BEGLOK
PUSHJ P,DRYROT
MOVE TAC,-1(P)
MOVEM TAC,LSTLOK#
POP P,TAC
;↑↑↑ Bug trap
SKIPE INTLEV ;or at interrupt level
JRST RETURN ;Yes, just return then
IFN NEWSW,< PUSHJ P,DRYROT >
IMSKST LOKMSK ;Restore mask
RETURN: AOS (P) ;Skip over interlock block
IFN DEBPRC,<
skipe debug
;The following must be preceded with "<" to assemb correctly
outchr [">"]
>;IFN DEBPRC
POPJ P,
BEND DELOCK
SUBTTL LOKENB - Enable interrupts inside an interlock
;
; Called by TURNON macro
; SKIPL LOKCNT
; PUSHJ P,LOKENB
; IMSKST [<interrupt bits>]
;
; Must preserve all ACs
;
; *** The following is a kludge ***
↑LOKENB:SKIPE INTLEV ;If at interrupt level, do IMSKST
POPJ P,
PUSH P,@(P) ;Push address of word containing bits
PUSH P,@(P) ;Push actual bits
MOVEM TAC,-1(P) ;Save TAC
POP P,TAC ;Get interrupt bits
ORM LOKMSK ;Turn them on in the mask
POP P,TAC ;Restore TAC
AOS (P) ;Skip over IMSKST
POPJ P, ;Return
SUBTTL LOKWAI - Wait for interlock
IFN NEWSW,<
BEGIN LOKWAI
;
; Called by:
; AOSE <interlock block>
; PUSHJ P,LOKWAI
; Preserves all AC's
; Note: this is generated by macro: ENTERLOCK
;
↑LOKWAI:
BEND LOKWAI
>;IFN NEWSW
SUBTTL USERMO - Enter user mode ***
BEGIN USERMODE
↑USERMODE: ;At interrupt level and want to do a waiting UUO.
SKIPN INTLEV
POPJ P, ;Dept. of Redundency Dept.
MOVEM 17,ACSAVE+17 ;Oh, dear! Let's see what see can do...
MOVEI 17,ACSAVE
BLT 17,ACSAVE+16 ;Save them acs
SETOM OLDMSK ;Save mask
IMSKCR OLDMSK
MOVE TAC,JOBTPC ;Don't forget the PC
MOVEM TAC,OLDPC
outchr ["U"]
UWAIT ;Wait for UUO to finish
DEBREAK
MOVEM 17,OLDACS+17 ;Save running processes acs
MOVEI 17,OLDACS
BLT 17,OLDACS+16
MOVSI P,ACSAVE ;Get back our interrupt acs
BLT P,P
SETZM INTLEV ;We're no longer at interrupt level
POPJ P, ;Return in user mode
ARRAY ACSAVE[20]
BEND USERMODE
SUBTTL LOGIT - Log messages
BEGIN LOGIT
↑LOGIT:
PUSH P,RET ;Save RET
PUSH P,[-1] ;Turn off interrupts
IMSKCR (P)
MOVE RET,-2(P)
MOVEM RET,SAVEPC
MOVE RET,LOGIOWD
PUSH RET,[HEADER]
PUSH RET,2
PUSH RET,3
PUSH RET,4
MOVEM RET,OTHERP
PUSH P,['NETGRF']
PUSH P,['LOG ']
PUSH P,['NETTVR']
PUSH P,[MSGBUF]
PUSH P,[PUSHJ P,SWITC2]
PUSHJ P,LOGMSG↑
JUMPN RET,LOGIT2
LOGIT1: AOS RET,SAVEPC
SKIPE -1(RET)
JRST LOGIT1
LOGIT2: MOVE RET,SAVEPC
MOVEM RET,-2(P)
POP P,RET
IMSKST RET
POP P,RET
POPJ P,
SWITCH: SKIPE DEBUG
OUTCHR RET
SWITC2: PUSH P,2
PUSH P,3
PUSH P,4
EXCH P,OTHERP
POP P,4
POP P,3
POP P,2
CPOPJ: POPJ P,
HEADER: MOVEI RET,"∂" ;RCV style header
PUSHJ P,SWITCH
ACCTIM RET, ;Include date and time
PUSH P,RET
PUSH P,[PUSHJ P,SWITCH]
PUSHJ P,WRDAYT↑
PUSH P,[[ASCIZ/ JOB /]]
PUSH P,[PUSHJ P,SWITCH]
PUSHJ P,WRASCZ↑
PJOB RET,
PUSH P,RET
PUSH P,[=10]
PUSH P,[PUSHJ P,SWITCH]
PUSHJ P,WRINT↑
PUSH P,[[ASCIZ/ NETGRF: /]]
PUSH P,[PUSHJ P,SWITCH]
PUSHJ P,WRASCZ↑
NXTITM: MOVE RET,@SAVEPC ;Get next item
AOS SAVEPC
JUMPE RET,LSTITM ;Zero marks end
PUSH P,RET ;Save item
HLRZ RET,RET ;Get type
CAIL RET,6 ;Legal?
CAILE RET,=15
SKIPA RET,[JRST NXTITM] ;Unknown type
MOVE RET,ITMTAB-6(RET) ;Get address of routine to call
EXCH RET,(P) ;Restore RET and invoke
POPJ P, ;conversion routine
LSTITM: MOVEI RET,15
PUSHJ P,SWITCH
MOVEI RET,12
PUSHJ P,SWITCH
SETZ RET,
PUSHJ P,SWITCH
ITMTAB: [PUSH P,(RET) ;6 - SIXBIT
PUSH P,[PUSHJ P,SWITCH]
PUSHJ P,WRSIX↑
JRST NXTITM ]
[HRLI RET,(<POINT 7,0>) ;7 - ASCIZ (Immediate)
PUSH P,RET
PUSH P,[PUSHJ P,SWITCH]
PUSHJ P,WRASCZ↑
JRST NXTITM ]
[PUSH P,(RET) ;8 - OCTAL
PUSH P,[8]
PUSH P,[PUSHJ P,SWITCH]
PUSHJ P,WRINT↑
JRST NXTITM ]
[JRST NXTITM ] ;9 - UNDEF
[PUSH P,(RET) ;10 - DECIMAL
PUSH P,[=10]
PUSH P,[PUSHJ P,SWITCH]
PUSHJ P,WRINT↑
JRST NXTITM ]
[HRLI RET,(<POINT 7,0>) ;11 - ASCIZ
PUSH P,(RET)
PUSH P,[PUSHJ P,SWITCH]
PUSHJ P,WRASCZ↑
JRST NXTITM ]
[JRST NXTITM] ;12 - UNDEF
[TLZ RET, ;13 - OCTAL (Immediate)
PUSH P,RET
PUSH P,[6]
MOD13A: PUSH P,[PUSHJ P,SWITCH]
PUSHJ P,WROCT↑
MOVEI RET," "
PUSHJ P,SWITCH
JRST NXTITM]
[PUSH P,(RET) ;14 - OCTAL
PUSH P,[=12]
JRST MOD13A]
[PUSH P,(RET) ;15 - SYMBOLIC
HRRZS (P)
PUSH P,[PUSHJ P,SWITCH]
PUSHJ P,WRSYMB↑
JRST NXTITM ]
INTEGER LOGSUB,SAVEPC,OTHERP
ARRAY MSGBUF[200]
BEND LOGIT
SUBTTL SETCHK - Initialize checksum of pure code
IFN CHKSW,<
↑SETCHK:PUSH P,[-1] ;Turn off interrupts
IMSKCR (P)
PUSHJ P,CALCHK ;Calculate checksum
MOVEM RET,CHKSUM ;Save it somewhere
;Now, we make a temperary file which will go away when we EXIT. There is
;is no straightforward way of doing this, so we get to fake it. First, we
;write the file and close it. Now, it is known to the file system. Then
;do a LOOKUP on each of two channels. We do a deletion on second channel,
;but the file only removed from its directory and doesn't go away yet,
;because it is being read on first channel! We IOPUSH it so it doesn't get
;accidentally closed, and the file stays around until we EXIT, at which point
;the system decides that no one else is reading it and it really deletes it!
IOPUSH CHKCHN,['SETCHK'] ;Save a channel
PUSHJ P,CHKERR
OPEN CHKCHN,CHKDEV ;Open device
PUSHJ P,CHKERR
PJOB TAC,
IDIVI TAC,=10 ;Put job number into filename
DPB TAC,[POINT 4,CHKNAM,35-6]
DPB TAC2,[POINT 4,CHKNAM,35]
SETZM CHKNAM+3 ;(Stupid LOOKUP clobbers PPN)
ENTER CHKCHN,CHKNAM ;ENTER file
PUSHJ P,CHKERR
OUT CHKCHN,CHKIOWD ;Write out core onto file
CAIA
PUSHJ P,CHKERR
CLOSE CHKCHN, ;Done writing, close it!
SETZM CHKNAM+3 ;(Stupid LOOKUP clobbers PPN)
LOOKUP CHKCHN,CHKNAM ;Open it on first channel (one we'll use)
PUSHJ P,CHKERR
IOPUSH CHKCHN,['CHKFIL']
PUSHJ P,CHKERR
OPEN CHKCHN,CHKDEV ;Open device
PUSHJ P,CHKERR
SETZM CHKNAM+3 ;(Stupid LOOKUP clobbers PPN)
LOOKUP CHKCHN,CHKNAM ;Open it on second channel
PUSHJ P,CHKERR
RENAME CHKCHN,ZERO4 ;and delete it!
PUSHJ P,CHKERR
CLOSE CHKCHN,
RELEASE CHKCHN,
IOPOP CHKCHN,['SETCHK']
PUSHJ P,CHKERR
IMSKST (P) ;Re-enable interrupts
POP P,(P)
POPJ P,
CHKERR: pushj p,dryrot
popj p,
ZERO4: BLOCK 4 ;For doing deletes
CHKDEV: 17
SIXBIT/DSK/
0
>;IFN CHKSW
SUBTTL SYSCHK - Checksum pure code and fix if pure code modified
IFN CHKSW,<
BEGIN SYSCHK
↑SYSCHK:PUSHJ P,CALCHK ;Calculate checksum
CAMN RET,CHKSUM ;Correct?
POPJ P, ;Yes, return quickly
PUSH P,[-1] ;Turn off interrupts
IMSKCR (P)
SKIPE DEBUG
OUTSTR[ASCIZ/Checksum failure!!!
/]
IOPUSH CHKCHN,['SYSCHK'] ;Save I/O
PUSHJ P,DRYROT
MOVE A,P ;Save PDL pointer
HLRE B,P ;See how much PDL we have left for
MOVN B,B ;saving garbage on
SUBI B,=10
CAIL B,=10 ;Don't bother with more than 10 errors
MOVEI B,=10
MOVE C,[IOWD =40,CHKTAB] ;We're generating code to print errors
IOPOP CHKCHN,['CHKFIL'] ;Get back file whereon pure code is saved
PUSHJ P,DRYROT
USETI CHKCHN,1 ;Back up to beginning of file
MOVE TAC,CHKIOWD ;Pointer to pure code
ADDI TAC,1
SETZM CHKERS ;Clear error count
CHKNXB: IN CHKCHN,[IOWD 200,CHKBUF ;Read in a buffer
0]
JRST CHKIOK
STATO CHKCHN,IODEND
PUSHJ P,DRYROT
CHKIOK: MOVE TAC2,[XWD -200,CHKBUF] ;Set up buffer pointer for compares
CHKLP: MOVE RET,(TAC2) ;Get word from disk
CAME RET,(TAC) ;Compare with word in core
JRST CMPBAD
FIXDON: AOBJP TAC,CHKDON ;Repeat until done with checking
AOBJN TAC2,CHKLP ;Repeat until with each buffer
JRST CHKNXB ;Then get another buffer
CMPBAD: SOJL B,NOROOM
PUSH C,[XWD =13,0] ;Compile: Address of error
HRRM TAC,(C)
PUSH C,[XWD =14,0] ;Compile: Disk contents
HRRM TAC,(C)
PUSH P,(TAC) ;Save old bad contents
PUSH C,[XWD =14,0] ;Compile: Memory contents
HRRM P,(C)
PUSH C,[XWD 7,[ASCIZ/
/]] ;Compile <CR><LF>
NOROOM: MOVEM RET,(TAC) ;Now fix up error!
AOS CHKERS ;Increment number of errors
JRST FIXDON ;And go look for more!
;Done with compare/fixing, now reset I/O and print errors
CHKDON: JUMPLE B,CHKDO2
PUSH C,[0]
PUSH C,[POPJ P,]
CHKDO2: IOPUSH CHKCHN,['CHKFIL'] ;Put copy pure code somewhere safe again
PUSHJ P,DRYROT
IOPOP CHKCHN,['SYSCHK'] ;Get back old I/O channel
PUSHJ P,DRYROT
PUSHJ P,CHKMSG ;Jump into code we're compiled!
MOVE P,A ;Throw away garbage on stack
IMSKST (P) ;Re-enable interrupts
POP P,(P) ;More stack garbage
POPJ P, ;And we're done
BEND SYSCHK
>;IFN CHKSW
SUBTTL CALCHK - Calculate checksum
IFN CHKSW,<
CALCHK: SETZ RET, ;Zero checksum
MOVE TAC,CHKIOWD ;Get IOWD pointer for pure code
CALCH2: ROT RET,1 ;So single bit clobbered gets seen
ADD RET,1(TAC) ;The index of 1 is because it's an IOWD
AOBJN TAC,CALCH2 ;Repeat for all of the pure code
POPJ P, ;Return checksum in RET
>;IFN CHKSW
;-------------------------------------------------
SUBTTL IMPOCNT- Return number of bytes which we can send IMP without waiting
BEGIN IMPOCNT
;
; MOVE U,<user number>
; PUSHJ P,OUTCNT
;
↑IMPOCNT:
PUSH P,A
MOVEI A,MTSIZE ;Get pointer to MTAPE block
IMULM U,A
MOVEI TAC,16
MOVEM TAC,MTBLKS(A)
MOVE TAC,[MTAPE 000,MTBLKS(A)]
DPB U,[POINT 4,TAC,12]
XCT TAC ;MTAPE CHAN,[GET_ALLOC...]
MOVE TAC,MTBLKS+7(A) ;Get number of bits he has left
IDIVI TAC,=8096-=36 ;Divide by number of bits per message
;(assume we one word's worth to boundaries)
SKIPN MTBLKS+10(A) ;Any messages at all?
JUMPE TAC,USEMES ;No, then skip it!
CAMLE TAC,MTBLKS+10(A) ;Enough messages left?
JRST [ MOVEI TAC,=8096-=36 ;No, see how well we can do with
IMUL TAC,MTBLKS+10(A) ;existing messages.
JRST USEMES ]
MOVE TAC,MTBLKS+7(A) ;Get number of bits
USEMES: MOVE RET,BYTSIZ(U)
IDIVM TAC,RET ;Divide by bytes to return number of bytes
POP P,A
POPJ P,
BEND IMPOCNT
SUBTTL IMPOCHR- Send character to IMP
BEGIN IMPOCHR
;
; Called with:
;
; MOVE U,<user number>
; MOVE RET,<character>
; PUSHJ P,IMPOCHR
;
; All other acs are preserved.
; If not enough space is left, then the process is delayed.
;
↑IMPOCHR:
IFN DKPRO,<
SKIPN DKFLAG(U) ;Is it a faked graphics channel?
JRST [ SKIPN DKOACT(U) ;No, but check for need of trailer word
JRST NOTAIL
PUSH P,RET
MOVEI RET,DKESC ;Send graphics trailer code
PUSHJ P,IMPOC2
MOVEI RET,DKEND
PUSHJ P,IMPOC2
SETZM DKOACT(U)
POP P,RET
NOTAIL: CAIGE RET,NUSERS ;If in TELNET mode
CAIE RET,DKESC ; and D. King escape to output
JRST IMPOC2
SKIPE DKFLAG+3(U) ; and D. King in use
PUSHJ P,IMPOC2 ; Then double the escape!
JRST IMPOC2 ]
PUSH P,RET ;Save byte to send
SUBI U,NUSERS ;Get into telnet channel
SUBI A,3*NUSERS
SKIPE DKOACT(U) ;Graphics last?
JRST NOHEAD ; Yes, don't send header
MOVEI RET,DKESC ;No, send header word
PUSHJ P,IMPOC2
MOVEI RET,DKBEG
PUSHJ P,IMPOC2
SETOM DKOACT(U)
NOHEAD: POP P,RET ;Get byte back to send
PUSHJ P,IMPOC2 ;Send character
CAIE RET,$IAC ;IAC or
CAIN RET,DKESC ;D.K. escape?
PUSHJ P,IMPOC2 ;Yes, double it
ADDI U,NUSERS
ADDI A,3*NUSERS
POPJ P,
>;IFN DKPRO
IMPOC2: SOSGE BYTLFT(U) ;Enough space for one more
JRST EMPCHK ;Maybe not, we'll see though
SOSG @IMOPCNT(U) ;Decrement number of characters left
PUSHJ P,IMPOUT ;Do output
IDPB RET,@IMOPPTR(U)
AOS BYTUSED(U) ;Remember that we used this byte
JFCL ;Space for OUTCHR RET
POPJ P,
;Our count of the number of bytes left is exhausted. See if the system has
;moved any since we checked last.
EMPCHK: PUSH P,TAC ;Save all this wonderful stuff
PUSH P,TAC2
PUSH P,RET
AOS IMOCNC ;For statistics
PUSHJ P,IMPOCNT ;Look again and see how much is left in system
SUB RET,BYTUSED(U) ;less that in our buffer
JUMPLE RET,EMPTY ;It really is empty
MORLFT: MOVEM RET,BYTLFT(U) ;Remember number for fast access
RETRY2: POP P,RET
POP P,TAC2
POP P,TAC
JRST IMPOC2
EMPTY: AOS IMOEMC ;For statistics
PUSHJ P,IMPOUT ;Output what's in our buffers before waiting
PUSH P,A ;Counter for timeout and deciding how long to wait
RETRY: AOS IMOEMS
;;; We underestimate to be sure, so negative is OK.
; SKIPE RET ;Better be zero
; PUSHJ P,DRYROT ;Lose big!
SKIPA A,[=30] ;Wait a half a second the first time
ADDI A,=60 ;Wait a second longer each time
CAIL A,=60*=85 ;Give up after we've waited about an hour (T = t(t+1)/2)
JRST [ MOVEI A,[ASCIZ/User host has not accepted output in an hour. User flushed.
/]↔ JRST KLUSER ]
PUSH P,A ;Wait a while before trying again
PUSHJ P,POSTPONE
PUSHJ P,IMPOCNT ;Look again and see how much is left in system
SUB RET,BYTUSED(U) ;less that in our buffer
JUMPLE RET,RETRY
POP P,A ;We got something, now we may proceed
JRST MORLFT
BEND IMPOCHR
SUBTTL IMPOUT - Output buffer to IMP
BEGIN IMPOUT
;
; Called with:
;
; MOVE U,<user number>
; PUSHJ P,IMPOUT
;
; All other acs are preserved.
; It is assumed that the caller know it will not wait!
;
↑IMPOUT:
IFN DKPRO,<
SKIPE DKFLAG(U) ;If faked channel,
JRST[ SUBI U,NUSERS ; Flush TELNET channel instead
PUSHJ P,IMPOU1
ADDI U,NUSERS
POPJ P,]
>;IFN DKPRO
IMPOU1: PUSH P,TAC ;Get an ac
PUSH P,TAC2 ;Get another
LDB TAC,[POINT 6,@IMOPPTR(U),5] ;Pick up position field
SUBI TAC,4 ;Turn on appropriate bits
JUMPLE TAC,ALLUSED
ASH TAC,-3 ;causing remaining bytes in word
MOVEI TAC2,1 ;not to be sent
ASH TAC2,(TAC)
SUBI TAC2,1
MOVE TAC,@IMOPPTR(U)
ORM TAC2,(TAC)
ALLUSED:MOVSI TAC,(<OUT>) ;Do an OUT
DPB U,[POINT 4,TAC,12]
CAIL U,GRFMUL*NUSERS ;Bug trap for U out of bounds
PUSHJ P,DRYROT
XCT TAC
SKIPA
; PUSHJ P,IMPERR ;Error return, see why
jrst[ movei a,[asciz/Error on output.
/]↔ pushj p,kluser
jrst prexit ]
SETZM BYTUSED(U) ;Nothing in buffers now
POP P,TAC2
POP P,TAC
POPJ P, ;Just in case it got fixed (fat chance)
BEND IMPOUT
SUBTTL IMPSTR - Output string to IMP
BEGIN IMPSTR
;
; PUSH P,[[ASCIZ/<msg>/]]
; PUSHJ P,IMPSTR
; Destroys TAC, RET
;
↑IMP8STR:SKIPA TAC,[POINT 8,0] ;For 8 bit strings
↑IMPSTR:MOVSI TAC,(<POINT 7,0>) ;For 7 bit strings
TDNN TAC,-1(P) ;Make sure we're not blasting exisiting pointer
HLLM TAC,-1(P)
PUSH P,A
MOVEI A,3 ;Figure offset in OUTHDR
IMULM U,A
LOOP: ILDB RET,-2(P)
JUMPE RET,[PUSHJ P,IMPOUT ;End of string, flush buffers
SETZM BYTLFT(U) ;Force reassessment of bytes remaining
POP P,A ;Restore A
POP P,-1(P) ;Flush argument
POPJ P,] ;Now, return
PUSHJ P,IMPOCHR
JRST LOOP
BEND IMPSTR
SUBTTL IMICHS - Skip if character ready from IMP
BEGIN IMICHS
;
; Called with:
;
; MOVE A,<3*user number>
; MOVE U,<user number>
; PUSHJ P,IMICHS
; <failure return>
;
; All other acs are preserved. Character is returned in RET
;
↑IMICHS:
IFN DKPRO,<
SKIPN DKIACT(U) ;Is this channel enabled?
POPJ P, ; No, that was quick!
SKIPE DKFLAG(U) ;Is this a DK graphics channel?
JRST [ SUBI U,NUSERS ;Yes, switch to TELNET channel
SUBI A,3*NUSERS
GRETRY: SKIPN DKESCF(U) ;Escape seen?
JRST GNOESC ; No
PUSHJ P,IMICH1 ;Get a character
JRST GRFRET ; None immediately available
SETZM DKESCF(U) ;Clear escape flag
CAIN RET,DKEND ;Is it end of graphics?
JRST [ SETOM DKIACT(U) ;Yes, enable TELNET
SETZM DKIACT+NUSERS(U) ;Disable graphics
SKIPE DEBUG
OUTCHR ["⊃"]
PUSHJ P,WAKEPR ;Wake any waiters
JRST GRFRET ] ;Then failure return
GNOESC: SKIPE DKIHI(U) ;Is there a high order bit yet?
JRST GETLOW ; Yes, look for low one
PUSHJ P,IMICH1 ;Is there anything there?
JRST GRFRET ; No,
CAIN RET,DKESC ;Escape?
JRST [ SETOM DKESCF(U) ; Yes, set escape flag
JRST GRETRY ]
ROT RET,4 ;Make into high order part
TLO RET,1 ;Make sure its nonzero
MOVEM RET,DKIHI(U) ;Save with left half as flag
GETLOW: PUSHJ P,IMICH1 ;Look for low order part
JRST GRFRET ; Not found
CAIN RET,DKESC ;Escape?
JRST [ SETOM DKESCF(U) ; Yes, set escape flag
JRST GRETRY ]
ANDI RET,17 ;Flush garbage
ADD RET,DKIHI(U) ;Add high order part
ANDI RET,377 ;Flush extra garbage
SETZM DKIHI(U) ;Clear waiting for low indication
AOS (P) ;Successful (skip) return
GRFRET: ADDI U,NUSERS
ADDI A,3*NUSERS
POPJ P, ]
TRETRY: SKIPE DKESCF(U)
JRST [
PUSHJ P,IMICH1 ;Get a character
POPJ P, ; None immediately available
SETZM DKESCF(U) ;Clear escape
CAIE RET,DKBEG ;Begin graphics?
JRST .+1 ; No, accept anything else as text
SETZM DKIACT(U) ;Turn off TELNET channel
SETOM DKIACT+NUSERS(U) ;Turn on graphics channel
SKIPE DEBUG
OUTCHR ["⊂"]
ADDI U,NUSERS ;And take nonskip return
PUSHJ P,WAKEPR
SUBI U,NUSERS ;After waking any waiters.
POPJ P,]
PUSHJ P,IMICH1 ;Get a character, if any
POPJ P, ; None, no skip return
CAIGE U,NUSERS ;Is this graphics channel?
CAIE RET,DKESC ; Or not beginning of graphics?
JRST SKPRET ; Yes, return quickly
SKIPN DKFLAG+NUSERS(U) ;Is DK format in use?
JRST SKPRET ; No, use this character
SETOM DKESCF(U) ;Indicate ESC seen
JRST TRETRY
SKPRET: AOS (P)
POPJ P,
>;IFN DKPRO
IMICH1: SOSLE INHDR+2(A) ;Anything there?
JRST GOTINP
PUSH P,TAC
PUSH P,TAC2
ENTERLOCK IMILOK ;Interlock against IMP input
MOVE TAC,[MTAPE 000,[10]] ;Skip if input present
DPB U,[POINT 4,TAC,12]
XCT TAC ;MTAPE CHAN,[INPSKP]
JRST [; SETZM PTIFUL(U)
SETZM ALLINP
LEAVELOCK IMILOK ;Interlock against IMP input
TURNON [INTINP] ;Turn on IMP input wait
POP P,TAC2
POP P,TAC
POPJ P, ]
LEAVELOCK IMILOK ;Interlock against IMP input
PUSHJ P,IMPIN ;Yes, read another buffer
POP P,TAC2
POP P,TAC
GOTINP: ILDB RET,INHDR+1(A) ;Get character
JUMPE RET,[LDB RET,[POINT 6,INHDR+1(A),5]
PUSH P,RET+1 ;If null, check if it's real
IDIVI RET,=8 ;Check ignore bit
POP P,RET+1
LDB RET,[POINT 1,@INHDR+1(A),35 ;(Use a table, it's
POINT 1,@INHDR+1(A),34 ;more efficient here).
POINT 1,@INHDR+1(A),33
POINT 1,@INHDR+1(A),32](RET)
JUMPN RET,IMICH1 ;Try again if to be ignored
JRST .+1 ] ;It's good, use it!
AOS (P)
POPJ P,
;Wait for character from IMP
↑IMICHW:
ENTERLOCK IMILOK
PUSHJ P,IMICHS ;Character ready
JRST DOWAIT ; No, wait for one
LEAVELOCK IMILOK
POPJ P, ; Yes, return it
DOWAIT:
SETZM PTIFUL(U) ;Losing timing race here
;**** Crock: LEAVELOCK IMILOK and TURNON [INTINP] in WSCHED !!!! ****
PUSH P,TAC
PUSHJ P,GETPRO
HRLM U,%DATUM(TAC) ;Code to wait on
POP P,TAC
PUSH P,[IMWQUE]
PUSHJ P,WSCHED ;Schedule to wait
JRST IMICHW
IFN DKPRO,<
;Wake process waiting for IMP input upon switching channels
WAKEPR:
PUSH P,A ;Save a few ACs
PUSH P,B
PUSH P,U ;Look for a process waiting for IMP input
PUSH P,[IMWQUE]
PUSHJ P,SRHQUE
JUMPN RET,[ ;Yes, give him the interrupt
PUSH P,RET ;Give him good service (could be ↑C)
PUSH P,[PRIQUE]
PUSHJ P,ENQUE
AOS RUNWAIT ;Another process waiting for service
JRST WAKEDN ]
HRRZ A,U
IDIVI A,NUSERS ;No one waiting, create a process to handle it
PUSH P,[IMISER↔GRISER](A);of the appropriate flavour
PUSHJ P,SCHED
SETOM PTIFUL(U)
WAKEDN: POP P,B
POP P,A
POPJ P,
>;IFN DKPRO
BEND IMICHS
SUBTTL IMPIN - Input buffer from IMP
BEGIN IMPIN
;
; Called with:
;
; MOVE U,<user number>
; PUSHJ P,IMPIN
;
; TAC is destroyed. All other acs are preserved.
; It is assumed that the caller know it will not wait!
;
IMPIN↑: MOVSI TAC,(<IN 000,>) ;Read a buffer
DPB U,[POINT 4,TAC,12]
XCT TAC ;IN CHAN,
POPJ P,
; PUSHJ P,IMPERR ;Oops, read error!
movei a,[asciz/Error on input. /] ;Tell loser why job is being killed
push p,a
pushj p,impstr
jrst kluser ;Now, flush the loser (chances are however, IMPOUT
;will flush him first)
BEND IMPIN
SUBTTL Misc. output routines: TYPOCT,TYPDEC,DRYROT
TYPOCT: POP P,TAC
PUSH P,[=8]
PUSH P,[OUTCHR 1]
PUSH P,TAC
JRST WRINT↑
TYPDEC: POP P,TAC
PUSH P,[=10]
PUSH P,[OUTCHR 1]
PUSH P,TAC
JRST WRINT↑
TYPSIX: POP P,TAC
PUSH P,[OUTCHR 1]
PUSH P,TAC
JRST WRSIX↑
DRYROT: PUSH P,[-1] ;Save mask and disable interrupts
IMSKCR (P)
PUSH P,TAC
PUSH P,RET
MOVE TAC,['ERRGRF'] ;No more customers, please
SETNAM TAC,
MOVE TAC,-3(P) ;PC for error routine.
SKIPE INTLEV
JRST [ PUSHJ P,USERMODE
PUSHJ P,LOGIT
XWD 7,[ASCIZ"Horrible error at interrupt level! PC/ "]
XWD =15,TAC
XWD 7,[ASCIZ/ = /]
XWD =14,TAC
0
; FATAL(Horrible error at interrupt level!)
; POPJ P,]
jrst dryro1 ]
PUSHJ P,LOGIT
XWD 7,[ASCIZ"Horrible error! PC/ "]
XWD =15,TAC
XWD 7,[ASCIZ/ = /]
XWD =14,TAC
0
PUSH P,[' TVR']
PUSH P,[[ASCIZ/;; DRYROT in NETGRF!
/]]↔ PUSHJ P,BLAST↑
; FATAL(Horrible error!)
DRYRO1: POP P,RET
POP P,TAC
SOSG LOSCNT ;Lost enough times yet?
EXIT 1, ; Yes, give up.
skipn jobddt
POPJ P,
skipn debug
JRST DRYRO2
PUSH P,[DRYRO2]
pop p,jobopc↑
jrst @jobddt↑
DRYRO2: IMSKST (P) ;Restore mask
POP P,(P)
POPJ P,
SUBTTL Storage
XLIST ;Don't list the literals!
LIT
LIST
PATCH: BLOCK 100 ;Every big program should have a little
ENDCOD: ;End of pure section
beglok: 0
THISJOB: BLOCK 1 ;Own job number
THISNAM: BLOCK 2 ;For sending letter to LOGGER
SIXBIT/DEBUG?/ ;So we get it back from LOGGER!!!
DEBUG: BLOCK 1
BEGZER::
CHKSUM: BLOCK 1 ;Checksum of program
OLDFF: BLOCK 1 ;Beginning of free space
INTLEV: BLOCK 1 ;-1 if at interrupt level
NXTTIM: BLOCK 1 ;Next clock interrupt at this time (tics past midnigth)
LASTRUN: BLOCK 1 ;Process last run
SYS.P: BLOCK 1 ;Top level stack pointer when running process
LAST.P: BLOCK 1 ;Copy of above just after running process
LASTPC: BLOCK 1 ;Last user PC
RUNWAIT: BLOCK 1 ;Number of processes waiting to be run
USEMAP: BLOCK 1 ;Map indicating which slots are available (1 if available)
USERS: BLOCK 1 ;Number of users
IMPMAP: BLOCK 1 ;Map indicating which slots are in use (1 if in use)
IMPSIZ: BLOCK 1 ;Size of IMP buffer
TTYSIZ: BLOCK 1 ;Size of IMP buffer
ALLFUL: BLOCK 1 ;Set if all our PTY output buffers are full
ALLINP: BLOCK 1 ;Set if all IMP has process pending to handle it
PTYIWA: BLOCK 1 ;Some PTY's buffer is full and IMP input is waiting
LOKCNT: BLOCK 1 ;Number of interlocks
LOKMSK: BLOCK 1 ;Interrupt mask for interlock kludge
LOSCNT: BLOCK 1 ;Number of times DRYROT called before giving up
; Statistics
INTCNT: BLOCK 1 ;Total number of interrupts
INTLOSS: BLOCK 1 ;Bad interrupt
CLKCNT: BLOCK 1 ;Number of clock interrupts
CLTDIF: BLOCK 1 ;Total number of tics system has been off for interrupts
CLKBAD: BLOCK 1 ;Number of bad clock interrupts (too early)
IMOCNC: BLOCK 1 ;Number of times we counted the byte count left
IMOEMC: BLOCK 1 ;Number of times we checked for an empty bit allocation
IMOEMS: BLOCK 1 ;Number of times we had to wait for allocation
INPCNT: BLOCK 1 ;Number of INTPTI interrupts
INPTOC: BLOCK 1 ;Number of INTPTO interrupts
IMICNT: BLOCK 1 ;Number of INTINP interrupts
;NXTSOC: BLOCK 1 ;Next socket for ICP
FREE1K: BLOCK 1 ;Free 1K block list
PROCFR: BLOCK 1 ;Free process block list
BEGQUE:: ;Beginning of queues (linked lists of processes)
RUNQUE: BLOCK QUESIZ ;Requesting to run
PRIQUE: BLOCK QUESIZ ;Requesting priority service
CLKQUE: BLOCK QUESIZ ;Requesting clock interrupts
IMWQUE: BLOCK QUESIZ ;Waiting for IMP input
IMSQUE: BLOCK QUESIZ ;Waiting for IMP status change
GRFQUE: BLOCK QUESIZ ;Waiting for a process to release graphics channel
LOKQUE: BLOCK QUESIZ ;Waiting for interlock
NQUES ←← (.-BEGQUE)/QUESIZ ;Number of queues
INLET: BLOCK =32 ;Incoming mail
OUTLET: BLOCK =32 ;Outgoing mail
;The following two locations must be kept together!!!
OLDMSK: BLOCK 1 ;This is for when we have to do something that
OLDPC: BLOCK 1 ;waits and we were at interrupt level
OLDACS: BLOCK 20
; User Tables
INHDR: BLOCK 3*GRFMUL*NUSERS ;Input buffer headers
OUTHDR: BLOCK 3*GRFMUL*NUSERS ;Output buffer headers
MTBLKS: BLOCK MTSIZE*(GRFMUL*NUSERS+NSPECU) ;MTAPE blocks
HOSTNA: BLOCK NUSERS ;Host name
HOSTNU: BLOCK NUSERS ;Host number
LSOCKT: BLOCK NUSERS*NUSERS+NSPECU ;Local socket
FSOCKT: BLOCK GRFMUL*NUSERS ;Foreign socket
BYTSIZ: BLOCK GRFMUL*NUSERS ;Byte size of connection
BYTUSE: BLOCK GRFMUL*NUSERS ;Number of bytes used in buffer
BYTLFT: BLOCK GRFMUL*NUSERS ;Our opinion of how many bytes are left
FLAGS: BLOCK NUSERS
IFN DKPRO,<
DKFLAG: BLOCK GRFMUL*NUSERS+NSPECU ;Losing D. King format!
DKIACT: BLOCK GRFMUL*NUSERS+NSPECU ;Input channel is empty
DKOACT: BLOCK NUSERS ;Output is graphics
DKESCF: BLOCK NUSERS ;Escape seen
DKIHI: BLOCK NUSERS ;High order bit stored here on input
>;IFN DKPRO
;Special table for FINGER, MAIL, etc.
;Format of each word: BYTE (12) <PTY number>, (24) SIXBIT/site name/
WHRTAB: BLOCK NUSERS
BLOCK 20-NUSERS
NUSERS
WHOTAB: BLOCK NUSERS
SPYTAB: BLOCK NUSERS
WHRLEN=.-WHRTAB
;Following two tables must be kept in order for graphics
PTYNUM: BLOCK NUSERS ;PTY line number if PTY in use
IFN GRFPRO,<
DPYFLG: BLOCK NUSERS ;-1 if display output
>
BLOCK NSPECU
PTOBUF: BLOCK NUSERS ;Buffers for PTY output
PTIFUL: BLOCK GRFMUL*NUSERS+NSPECU ;Flag indicating that a process has been scheduled
;to handle input to PTY
PTOFUL: BLOCK NUSERS ;Flag indicating NETGRF's PTY ouput buffer full if
;non-negative
PTBUSY: BLOCK NUSERS ;Flag indicating PTY's input buffer full
PROMAP: BLOCK NUSERS ;Bit map indicating which protocols have been sent
IMPST1: BLOCK 3*(GRFMUL*NUSERS+NSPECU) ;Last known status of IMP channel
CHGFLG: BLOCK GRFMUL*NUSERS+NSPECU ;IMP status change if non-zero
IFN GRFPRO,<
; Graphics tables
IIFLAG: BLOCK NUSERS
XMIN: BLOCK NUSERS ;X minimum (leftmost)
YMIN: BLOCK NUSERS ;Y minimum (rightmost)
XMUL: BLOCK NUSERS ;X Multiplier to get user coordinates
YMUL: BLOCK NUSERS ;Y Multiplier to get user coordinates
XK: BLOCK NUSERS ;X constant for SNDCOORD (= XMIN+XMUL/2)
YK: BLOCK NUSERS ;Y constant for SNDCOORD (= YMIN+YMUL/2)
BYTES: BLOCK NUSERS ;Number bytes to represent user coordinates
ROTS: BLOCK NUSERS ;Amount to rotate to get first byte
DPYUSE: BLOCK NUSERS ;Flag indicating display channel in use
IMPLTB: BLOCK 8*NUSERS ;Bit table indication which commands are implemented
;by the user program (foreign end)
>;IFN GRFPRO
IFN IMLSW,<
; Imlac mode
IMLACT: BLOCK NUSERS ;Indicates in Imlac mode
>;IFN IMLSW
; Interlock blocks
$BGLOK::
IMILOK: BLOCK LOCKSZ ;IMP input
IMOLOK: BLOCK LOCKSZ ;IMP output
IMCLOK: BLOCK LOCKSZ ;IMP change interlock
IMMLOK: BLOCK LOCKSZ ;IMP MTAPE block
PTOLOK: BLOCK LOCKSZ ;PTY output
.1KLOK: BLOCK LOCKSZ ;Interlock on 1K free list
PBKLOK: BLOCK LOCKSZ ;Interlock on process block free list
QUELOK: BLOCK LOCKSZ ;Interlock on queue change
C17LOK: BLOCK LOCKSZ ;Interlock on I/O channel 17
DPYLOK: BLOCK LOCKSZ ;General interlock on graphics
ENDLOK::
VAR
ENDZER←←.-1
;For fast IMPOCH, make pointer into OUTHDR blocks
IMOPPTR:FOR I←0,GRFMUL*NUSERS-1,1 < 3*I+OUTHDR+1↔ >
IMOPCNT:FOR I←0,GRFMUL*NUSERS-1,1 < 3*I+OUTHDR+2↔ >
IMPBLK: 10 ;OPEN block for IMP
SIXBIT/IMP/
XWD 0,0
CHKNAM: SIXBIT/GSAV00/
SIXBIT/TMP/
0
0
CRLF: ASCIZ/
/
SPYTMC: XWD 'WHO',0
IOWD 10,SPYBUF
SIXBIT/100100/
SPYBUF: BLOCK 10
IFN DEBPRC,<
; Display buffer showing last interrupt
INTDPY: XWD 400000,.+4
INDPSZ
0
0
0
3020B10+765B21+146 ;AIVECT -760,765
ASCID/ I/
NAMLOC: ASCID/-----/
ascid/
/]
foodpy: ascid/AAAAA/
0
INDPSZ←.-INTDPY-4
>;IFN DEBPRC
IFN CHKSW,<
;The following is called by memory fix routine SYSCHK to print the
;errors. CHKBUF is compiled by that routine and looks something
;like:
; XWD =13,2244 ;Memory address
; XWD =8,2244 ;Contents
; XWD =8,PDL+12 ;Old contents (saved on stack)
; XWD 7,CRLF
; ...
CHKMSG: PUSHJ P,LOGIT
XWD 7,[ASCIZ/Checksum failure:
/]
XWD =10,CHKERS
XWD 7,[ASCIZ/ errors detected.
Address Disk Core
/]
CHKTAB: BLOCK =40
XWD 7,[ASCIZ/.../]
0
POPJ P,
CHKERS: BLOCK 1
CHKIOWD:IOWD ENDCOD-$BGNET,$BGNET
0
CHKBUF: BLOCK 200
PARMSG: PUSHJ P,LOGIT
XWD 7,[ASCIZ/Parity error: (most recent)
Address Prot-Rel Core
/]
XWD =13,0
XWD =14,0
XWD =14,0
0
POPJ P,
>;IFN CHKSW
PDL: BLOCK 100
PDLIOW: IOWD .-PDL,PDL
IPDL: BLOCK 100
IPDLIO: IOWD .-IPDL,IPDL
LOGPDL: BLOCK 40
LOGIOW: IOWD .-LOGPDL,LOGPDL
END START